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, 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(-imapd));
13 my $inboxdir = $ENV{GIANT_INBOX_DIR};
16 require_mods('IO::Socket::SSL', 1);
17 $TEST_TLS = $ENV{TEST_TLS} // 1;
19 plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inboxdir;
20 diag 'TEST_COMPRESS='.($ENV{TEST_COMPRESS} // 1) . " TEST_TLS=$TEST_TLS";
22 my ($cert, $key) = qw(certs/server-cert.pem certs/server-key.pem);
24 if (!-r $key || !-r $cert) {
26 "certs/ missing for $0, run ./certs/create-certs.perl";
28 use_ok 'PublicInbox::TLS';
30 my ($tmpdir, $for_destroy) = tmpdir();
31 my ($out, $err) = ("$tmpdir/stdout.log", "$tmpdir/stderr.log");
32 my $pi_config = "$tmpdir/pi_config";
33 my $group = 'inbox.test';
34 local $SIG{PIPE} = 'IGNORE'; # for IMAPC (below)
35 my $imaps = tcp_server();
37 open my $fh, '>', $pi_config or die "open: $!\n";
38 print $fh <<EOF or die;
39 [publicinbox "imapd-tls"]
41 address = $group\@example.com
45 close $fh or die "close: $!\n";
47 my $imaps_addr = tcp_host_port($imaps);
48 my $env = { PI_CONFIG => $pi_config };
49 my $arg = $TEST_TLS ? [ "-limaps://$imaps_addr/?cert=$cert,key=$key" ] : [];
50 my $cmd = [ '-imapd', '-W0', @$arg, "--stdout=$out", "--stderr=$err" ];
52 # run_mode=0 ensures Test::More FDs don't get shared
53 my $td = start_script($cmd, $env, { 3 => $imaps, run_mode => 0 });
57 SSL_hostname => 'server.local',
58 SSL_verifycn_name => 'server.local',
59 SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(),
60 SSL_ca_file => 'certs/test-ca.pem',
62 my $ctx = IO::Socket::SSL::SSL_Context->new(%ssl_opt);
64 # cf. https://rt.cpan.org/Ticket/Display.html?id=129463
65 my $mode = eval { Net::SSLeay::MODE_RELEASE_BUFFERS() };
66 if ($mode && $ctx->{context}) {
67 eval { Net::SSLeay::CTX_set_mode($ctx->{context}, $mode) };
68 warn "W: $@ (setting SSL_MODE_RELEASE_BUFFERS)\n" if $@;
71 $ssl_opt{SSL_reuse_ctx} = $ctx;
72 $ssl_opt{SSL_startHandshake} = 0;
74 chomp(my $nfd = `/bin/sh -c 'ulimit -n'`);
76 ok($nfd > 0, 'positive FD count');
78 $nfd = $MAX_FD if $nfd >= $MAX_FD;
80 sub once { 0 }; # stops event loop
82 # setup the event loop so that it exits at every step
83 # while we're still doing connect(2)
84 PublicInbox::DS->SetLoopTimeout(0);
85 PublicInbox::DS->SetPostLoopCallback(\&once);
87 if ($^O eq 'linux' && open(my $f, '<', "/proc/$pid/status")) {
88 diag(grep(/RssAnon/, <$f>));
91 foreach my $n (1..$nfd) {
92 my $io = tcp_connect($imaps, Blocking => 0);
93 $io = IO::Socket::SSL->start_SSL($io, %ssl_opt) if $TEST_TLS;
96 # one step through the event loop
97 # do a little work as we connect:
98 PublicInbox::DS::event_loop();
100 # try not to overflow the listen() backlog:
101 if (!($n % 128) && $DONE != $n) {
102 diag("nr: ($n) $DONE/$nfd");
103 PublicInbox::DS->SetLoopTimeout(-1);
104 PublicInbox::DS->SetPostLoopCallback(sub { $DONE != $n });
107 PublicInbox::DS::event_loop();
110 PublicInbox::DS->SetLoopTimeout(0);
111 PublicInbox::DS->SetPostLoopCallback(\&once);
115 # run the event loop normally, now:
116 diag "done?: @".time." $DONE/$nfd";
118 PublicInbox::DS->SetLoopTimeout(-1);
119 PublicInbox::DS->SetPostLoopCallback(sub { $DONE != $nfd });
120 PublicInbox::DS::event_loop();
122 is($nfd, $DONE, "$nfd/$DONE done");
123 if ($^O eq 'linux' && open(my $f, '<', "/proc/$pid/status")) {
124 diag(grep(/RssAnon/, <$f>));
125 diag " SELF lsof | wc -l ".`lsof -p $$ |wc -l`;
126 diag "SERVER lsof | wc -l ".`lsof -p $pid |wc -l`;
128 PublicInbox::DS->Reset;
131 is($?, 0, 'no error in exited process');
136 use parent qw(PublicInbox::DS);
137 # fields: step: state machine, zin: Zlib inflate context
138 use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT EPOLLONESHOT);
139 use Errno qw(EAGAIN);
140 # determines where we start event_step
141 use constant FIRST_STEP => ($ENV{TEST_COMPRESS} // 1) ? -2 : 0;
143 # return true if complete, false if incomplete (or failure)
144 sub connect_tls_step {
146 my $sock = $self->{sock} or return;
147 return 1 if $sock->connect_SSL;
148 return $self->drop("$!") if $! != EAGAIN;
149 if (my $ev = PublicInbox::TLS::epollbit()) {
150 unshift @{$self->{wbuf}}, \&connect_tls_step;
151 PublicInbox::DS::epwait($sock, $ev | EPOLLONESHOT);
154 $self->drop('BUG? EAGAIN but '.PublicInbox::TLS::err());
161 # TLS negotiation happens in flush_write via {wbuf}
162 return unless $self->flush_write && $self->{sock};
164 if ($self->{step} == -2) {
165 $self->do_read(\(my $buf = ''), 128) or return;
166 $buf =~ /\A\* OK / or die 'no greeting';
168 $self->write(\"1 COMPRESS DEFLATE\r\n");
170 if ($self->{step} == -1) {
171 $self->do_read(\(my $buf = ''), 128) or return;
172 $buf =~ /\A1 OK / or die "no compression $buf";
173 IMAPCdeflate->enable($self);
175 $self->write(\"2 EXAMINE inbox.test.0\r\n");
177 if ($self->{step} == 0) {
178 $self->do_read(\(my $buf = ''), 128) or return;
179 $buf =~ /\A\* OK / or die 'no greeting';
181 $self->write(\"2 EXAMINE inbox.test.0\r\n");
183 if ($self->{step} == 1) {
185 until ($buf =~ /^2 OK \[READ-ONLY/ms) {
186 $self->do_read(\$buf, 4096, length($buf)) or return;
189 $self->write(\"3 UID FETCH 1 (UID FLAGS)\r\n");
191 if ($self->{step} == 2) {
193 until ($buf =~ /^3 OK /ms) {
194 $self->do_read(\$buf, 4096, length($buf)) or return;
197 $self->write(\"4 IDLE\r\n");
199 if ($self->{step} == 3) {
200 $self->do_read(\(my $buf = ''), 128) or return;
203 $self->{step} = 5; # all done
205 warn "$self->{step} Should never get here $self";
210 my ($class, $io) = @_;
211 my $self = bless { step => FIRST_STEP }, $class;
212 if ($io->can('connect_SSL')) {
213 $self->{wbuf} = [ \&connect_tls_step ];
215 # wait for connect(), and maybe SSL_connect()
216 $self->SUPER::new($io, EPOLLOUT|EPOLLONESHOT);
220 package IMAPCdeflate;
223 use Compress::Raw::Zlib;
224 use PublicInbox::IMAP;
228 %ZIN_OPT = ( -WindowBits => -15, -AppendOutput => 1 );
229 *write = \&PublicInbox::DSdeflate::write;
230 *do_read = \&PublicInbox::DSdeflate::do_read;
234 my ($class, $self) = @_;
235 my ($in, $err) = Compress::Raw::Zlib::Inflate->new(%ZIN_OPT);
236 die "Inflate->new failed: $err" if $err != Z_OK;