]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/IMAPdeflate.pm
avoid calling waitpid from children in DESTROY
[public-inbox.git] / lib / PublicInbox / IMAPdeflate.pm
1 # Copyright (C) 2020 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3 # TODO: reduce duplication from PublicInbox::NNTPdeflate
4
5 # RFC 4978
6 package PublicInbox::IMAPdeflate;
7 use strict;
8 use warnings;
9 use 5.010_001;
10 use base qw(PublicInbox::IMAP);
11 use Compress::Raw::Zlib;
12
13 my %IN_OPT = (
14         -Bufsize => 1024,
15         -WindowBits => -15, # RFC 1951
16         -AppendOutput => 1,
17 );
18
19 # global deflate context and buffer
20 my $zbuf = \(my $buf = '');
21 my $zout;
22 {
23         my $err;
24         ($zout, $err) = Compress::Raw::Zlib::Deflate->new(
25                 # nnrpd (INN) and Compress::Raw::Zlib favor MemLevel=9,
26                 # the zlib C library and git use MemLevel=8 as the default
27                 # -MemLevel => 9,
28                 -Bufsize => 65536, # same as nnrpd
29                 -WindowBits => -15, # RFC 1951
30                 -AppendOutput => 1,
31         );
32         $err == Z_OK or die "Failed to initialize zlib deflate stream: $err";
33 }
34
35 sub enable {
36         my ($class, $self, $tag) = @_;
37         my ($in, $err) = Compress::Raw::Zlib::Inflate->new(%IN_OPT);
38         if ($err != Z_OK) {
39                 $self->err("Inflate->new failed: $err");
40                 $self->write(\"$tag BAD failed to activate compression\r\n");
41                 return;
42         }
43         $self->write(\"$tag OK DEFLATE active\r\n");
44         bless $self, $class;
45         $self->{zin} = $in;
46 }
47
48 # overrides PublicInbox::NNTP::compressed
49 sub compressed { 1 }
50
51 sub do_read ($$$$) {
52         my ($self, $rbuf, $len, $off) = @_;
53
54         my $zin = $self->{zin} or return; # closed
55         my $doff;
56         my $dbuf = delete($self->{dbuf}) // '';
57         $doff = length($dbuf);
58         my $r = PublicInbox::DS::do_read($self, \$dbuf, $len, $doff) or return;
59
60         # Workaround inflate bug appending to OOK scalars:
61         # <https://rt.cpan.org/Ticket/Display.html?id=132734>
62         # We only have $off if the client is pipelining, and pipelining
63         # is where our substr() OOK optimization in event_step makes sense.
64         if ($off) {
65                 my $copy = $$rbuf;
66                 undef $$rbuf;
67                 $$rbuf = $copy;
68         }
69
70         # assert(length($$rbuf) == $off) as far as NNTP.pm is concerned
71         # -ConsumeInput is true, so $dbuf is automatically emptied
72         my $err = $zin->inflate($dbuf, $rbuf);
73         if ($err == Z_OK) {
74                 $self->{dbuf} = $dbuf if $dbuf ne '';
75                 $r = length($$rbuf) and return $r;
76                 # nothing ready, yet, get more, later
77                 $self->requeue;
78         } else {
79                 delete $self->{zin};
80                 $self->close;
81         }
82         0;
83 }
84
85 # override PublicInbox::DS::msg_more
86 sub msg_more ($$) {
87         my $self = $_[0];
88
89         # $_[1] may be a reference or not for ->deflate
90         my $err = $zout->deflate($_[1], $zbuf);
91         $err == Z_OK or die "->deflate failed $err";
92         1;
93 }
94
95 sub zflush ($) {
96         my ($self) = @_;
97
98         my $deflated = $zbuf;
99         $zbuf = \(my $next = '');
100
101         my $err = $zout->flush($deflated, Z_FULL_FLUSH);
102         $err == Z_OK or die "->flush failed $err";
103
104         # We can still let the lower socket layer do buffering:
105         PublicInbox::DS::msg_more($self, $$deflated);
106 }
107
108 # compatible with PublicInbox::DS::write, so $_[1] may be a reference or not
109 sub write ($$) {
110         my $self = $_[0];
111         return PublicInbox::DS::write($self, $_[1]) if ref($_[1]) eq 'CODE';
112
113         my $deflated = $zbuf;
114         $zbuf = \(my $next = '');
115
116         # $_[1] may be a reference or not for ->deflate
117         my $err = $zout->deflate($_[1], $deflated);
118         $err == Z_OK or die "->deflate failed $err";
119         $err = $zout->flush($deflated, Z_FULL_FLUSH);
120         $err == Z_OK or die "->flush failed $err";
121
122         # We can still let the socket layer do buffering:
123         PublicInbox::DS::write($self, $deflated);
124 }
125
126 1;