1 # Copyright (C) 2020 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
5 package PublicInbox::GzipFilter;
7 use parent qw(Exporter);
8 use Compress::Raw::Zlib qw(Z_FINISH Z_OK);
9 our @EXPORT_OK = qw(gzf_maybe);
10 my %OPT = (-WindowBits => 15 + 16, -AppendOutput => 1);
11 my @GZIP_HDRS = qw(Vary Accept-Encoding Content-Encoding gzip);
13 sub new { bless {}, shift }
15 # for Qspawn if using $env->{'pi-httpd.async'}
22 # returns `0' and not `undef' on failure (see Www*Stream)
24 my ($res_hdr, $env) = @_;
25 return 0 if (($env->{HTTP_ACCEPT_ENCODING}) // '') !~ /\bgzip\b/;
26 my ($gz, $err) = Compress::Raw::Zlib::Deflate->new(%OPT);
27 return 0 if $err != Z_OK;
29 # in case Plack::Middleware::Deflater is loaded:
30 $env->{'plack.skip-deflater'} = 1;
31 push @$res_hdr, @GZIP_HDRS;
32 bless { gz => $gz }, __PACKAGE__;
36 my ($res_hdr, $env) = @_;
37 return if ($env->{HTTP_ACCEPT_ENCODING} // '') !~ /\bgzip\b/;
38 my $hdr = join("\n", @$res_hdr);
39 return if $hdr !~ m!^Content-Type\n
40 (?:(?:text/(?:html|plain))|
41 application/atom\+xml)\b!ixsm;
42 return if $hdr =~ m!^Content-Encoding\ngzip\n!smi;
43 return if $hdr =~ m!^Content-Length\n[0-9]+\n!smi;
44 return if $hdr =~ m!^Transfer-Encoding\n!smi;
45 # in case Plack::Middleware::Deflater is loaded:
46 return if $env->{'plack.skip-deflater'}++;
47 push @$res_hdr, @GZIP_HDRS;
48 bless {}, __PACKAGE__;
52 my ($gz, $err) = Compress::Raw::Zlib::Deflate->new(%OPT);
53 $err == Z_OK or die "Deflate->new failed: $err";
57 # for GetlineBody (via Qspawn) when NOT using $env->{'pi-httpd.async'}
58 # Also used for ->getline callbacks
60 my $self = $_[0]; # $_[1] => input
62 # allocate the zlib context lazily here, instead of in ->new.
63 # Deflate contexts are memory-intensive and this object may
64 # be sitting in the Qspawn limiter queue for a while.
65 my $gz = $self->{gz} //= gzip_or_die();
66 my $zbuf = delete($self->{zbuf});
67 if (defined $_[1]) { # my $buf = $_[1];
68 my $err = $gz->deflate($_[1], $zbuf);
69 die "gzip->deflate: $err" if $err != Z_OK;
70 return $zbuf if length($zbuf) >= 8192;
72 $self->{zbuf} = $zbuf;
74 } else { # undef == EOF
75 my $err = $gz->flush($zbuf, Z_FINISH);
76 die "gzip->flush: $err" if $err != Z_OK;
82 # my $ret = bytes::length($_[1]); # XXX does anybody care?
83 $_[0]->{fh}->write(translate($_[0], $_[1]));
86 # similar to ->translate; use this when we're sure we know we have
87 # more data to buffer after this
89 my $self = $_[0]; # $_[1] => input
90 my $err = $self->{gz}->deflate($_[1], $self->{zbuf});
91 die "gzip->deflate: $err" if $err != Z_OK;
95 # flushes and returns the final bit of gzipped data
97 my $self = $_[0]; # $_[1] => final input (optional)
98 my $zbuf = delete $self->{zbuf};
99 my $gz = delete $self->{gz};
102 $err = $gz->deflate($_[1], $zbuf);
103 die "gzip->deflate: $err" if $err != Z_OK;
105 $err = $gz->flush($zbuf, Z_FINISH);
106 die "gzip->flush: $err" if $err != Z_OK;
112 my $fh = delete $self->{fh};
113 $fh->write(zflush($self));