2 # Copyright (C) 2020 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, particularly after EXAMINE when
5 # Message Sequence Numbers are loaded
8 use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET);
9 use PublicInbox::TestCommon;
10 use PublicInbox::Syscall qw(:epoll);
12 require_mods(qw(DBD::SQLite Email::Address::XS||Mail::Address
14 my $inboxdir = $ENV{GIANT_INBOX_DIR};
17 require_mods('IO::Socket::SSL', 1);
18 $TEST_TLS = $ENV{TEST_TLS} // 1;
20 plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inboxdir;
21 diag 'TEST_COMPRESS='.($ENV{TEST_COMPRESS} // 1) . " TEST_TLS=$TEST_TLS";
23 my ($cert, $key) = qw(certs/server-cert.pem certs/server-key.pem);
25 if (!-r $key || !-r $cert) {
27 "certs/ missing for $0, run ./certs/create-certs.perl";
29 use_ok 'PublicInbox::TLS';
31 my ($tmpdir, $for_destroy) = tmpdir();
32 my ($out, $err) = ("$tmpdir/stdout.log", "$tmpdir/stderr.log");
33 my $pi_config = "$tmpdir/pi_config";
34 my $group = 'inbox.test';
35 local $SIG{PIPE} = 'IGNORE'; # for IMAPC (below)
36 my $imaps = tcp_server();
38 open my $fh, '>', $pi_config or die "open: $!\n";
39 print $fh <<EOF or die;
40 [publicinbox "imapd-tls"]
42 address = $group\@example.com
46 close $fh or die "close: $!\n";
48 my $imaps_addr = $imaps->sockhost . ':' . $imaps->sockport;
49 my $env = { PI_CONFIG => $pi_config };
50 my $arg = $TEST_TLS ? [ "-limaps://$imaps_addr/?cert=$cert,key=$key" ] : [];
51 my $cmd = [ '-imapd', '-W0', @$arg, "--stdout=$out", "--stderr=$err" ];
52 my $td = start_script($cmd, $env, { 3 => $imaps });
56 SSL_hostname => 'server.local',
57 SSL_verifycn_name => 'server.local',
58 SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(),
59 SSL_ca_file => 'certs/test-ca.pem',
61 my $ctx = IO::Socket::SSL::SSL_Context->new(%ssl_opt);
63 # cf. https://rt.cpan.org/Ticket/Display.html?id=129463
64 my $mode = eval { Net::SSLeay::MODE_RELEASE_BUFFERS() };
65 if ($mode && $ctx->{context}) {
66 eval { Net::SSLeay::CTX_set_mode($ctx->{context}, $mode) };
67 warn "W: $@ (setting SSL_MODE_RELEASE_BUFFERS)\n" if $@;
70 $ssl_opt{SSL_reuse_ctx} = $ctx;
71 $ssl_opt{SSL_startHandshake} = 0;
73 chomp(my $nfd = `/bin/sh -c 'ulimit -n'`);
75 ok($nfd > 0, 'positive FD count');
77 $nfd = $MAX_FD if $nfd >= $MAX_FD;
79 sub once { 0 }; # stops event loop
81 # setup the event loop so that it exits at every step
82 # while we're still doing connect(2)
83 PublicInbox::DS->SetLoopTimeout(0);
84 PublicInbox::DS->SetPostLoopCallback(\&once);
86 if ($^O eq 'linux' && open(my $f, '<', "/proc/$pid/status")) {
87 diag(grep(/RssAnon/, <$f>));
90 foreach my $n (1..$nfd) {
91 my $io = tcp_connect($imaps, Blocking => 0);
92 $io = IO::Socket::SSL->start_SSL($io, %ssl_opt) if $TEST_TLS;
95 # one step through the event loop
96 # do a little work as we connect:
97 PublicInbox::DS->EventLoop;
99 # try not to overflow the listen() backlog:
100 if (!($n % 128) && $DONE != $n) {
101 diag("nr: ($n) $DONE/$nfd");
102 PublicInbox::DS->SetLoopTimeout(-1);
103 PublicInbox::DS->SetPostLoopCallback(sub { $DONE != $n });
106 PublicInbox::DS->EventLoop;
109 PublicInbox::DS->SetLoopTimeout(0);
110 PublicInbox::DS->SetPostLoopCallback(\&once);
114 # run the event loop normally, now:
115 diag "done?: @".time." $DONE/$nfd";
117 PublicInbox::DS->SetLoopTimeout(-1);
118 PublicInbox::DS->SetPostLoopCallback(sub { $DONE != $nfd });
119 PublicInbox::DS->EventLoop;
121 is($nfd, $DONE, "$nfd/$DONE done");
122 if ($^O eq 'linux' && open(my $f, '<', "/proc/$pid/status")) {
123 diag(grep(/RssAnon/, <$f>));
124 diag " SELF lsof | wc -l ".`lsof -p $$ |wc -l`;
125 diag "SERVER lsof | wc -l ".`lsof -p $pid |wc -l`;
127 PublicInbox::DS->Reset;
130 is($?, 0, 'no error in exited process');
135 use base qw(PublicInbox::DS);
136 use fields qw(step zin);
137 use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT EPOLLONESHOT);
138 use Errno qw(EAGAIN);
139 # determines where we start event_step
140 use constant FIRST_STEP => ($ENV{TEST_COMPRESS} // 1) ? -2 : 0;
142 # return true if complete, false if incomplete (or failure)
143 sub connect_tls_step {
145 my $sock = $self->{sock} or return;
146 return 1 if $sock->connect_SSL;
147 return $self->drop("$!") if $! != EAGAIN;
148 if (my $ev = PublicInbox::TLS::epollbit()) {
149 unshift @{$self->{wbuf}}, \&connect_tls_step;
150 PublicInbox::DS::epwait($sock, $ev | EPOLLONESHOT);
153 $self->drop('BUG? EAGAIN but '.PublicInbox::TLS::err());
160 # TLS negotiation happens in flush_write via {wbuf}
161 return unless $self->flush_write && $self->{sock};
163 if ($self->{step} == -2) {
164 $self->do_read(\(my $buf = ''), 128) or return;
165 $buf =~ /\A\* OK / or die 'no greeting';
167 $self->write(\"1 COMPRESS DEFLATE\r\n");
169 if ($self->{step} == -1) {
170 $self->do_read(\(my $buf = ''), 128) or return;
171 $buf =~ /\A1 OK / or die "no compression $buf";
172 IMAPCdeflate->enable($self);
174 $self->write(\"2 EXAMINE inbox.test.0\r\n");
176 if ($self->{step} == 0) {
177 $self->do_read(\(my $buf = ''), 128) or return;
178 $buf =~ /\A\* OK / or die 'no greeting';
180 $self->write(\"2 EXAMINE inbox.test.0\r\n");
182 if ($self->{step} == 1) {
184 until ($buf =~ /^2 OK \[READ-ONLY/ms) {
185 $self->do_read(\$buf, 4096, length($buf)) or return;
188 $self->write(\"3 UID FETCH 1 (UID FLAGS)\r\n");
190 if ($self->{step} == 2) {
192 until ($buf =~ /^3 OK /ms) {
193 $self->do_read(\$buf, 4096, length($buf)) or return;
196 $self->write(\"4 IDLE\r\n");
198 if ($self->{step} == 3) {
199 $self->do_read(\(my $buf = ''), 128) or return;
202 $self->{step} = 5; # all done
204 warn "$self->{step} Should never get here $self";
209 my ($class, $io) = @_;
210 my $self = fields::new($class);
212 # wait for connect(), and maybe SSL_connect()
213 $self->SUPER::new($io, EPOLLOUT|EPOLLONESHOT);
214 if ($io->can('connect_SSL')) {
215 $self->{wbuf} = [ \&connect_tls_step ];
217 $self->{step} = FIRST_STEP;
222 package IMAPCdeflate;
224 use base qw(IMAPC); # parent doesn't work for fields
225 use Hash::Util qw(unlock_hash); # dependency of fields for perl 5.10+, anyways
226 use Compress::Raw::Zlib;
227 use PublicInbox::IMAPdeflate;
230 %ZIN_OPT = ( -WindowBits => -15, -AppendOutput => 1 );
231 *write = \&PublicInbox::IMAPdeflate::write;
232 *do_read = \&PublicInbox::IMAPdeflate::do_read;
236 my ($class, $self) = @_;
237 my ($in, $err) = Compress::Raw::Zlib::Inflate->new(%ZIN_OPT);
238 die "Inflate->new failed: $err" if $err != Z_OK;