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(gzip_maybe 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'}
23 my ($res_hdr, $env) = @_;
24 return if (($env->{HTTP_ACCEPT_ENCODING}) // '') !~ /\bgzip\b/;
26 my ($gz, $err) = Compress::Raw::Zlib::Deflate->new(%OPT);
27 return if $err != Z_OK;
29 # in case Plack::Middleware::Deflater is loaded:
30 $env->{'plack.skip-deflater'} = 1;
32 push @$res_hdr, @GZIP_HDRS;
37 my ($res_hdr, $env) = @_;
38 my $gz = gzip_maybe($res_hdr, $env) or return 0;
39 bless { gz => $gz }, __PACKAGE__;
42 # for GetlineBody (via Qspawn) when NOT using $env->{'pi-httpd.async'}
43 # Also used for ->getline callbacks
45 my $self = $_[0]; # $_[1] => input
47 # allocate the zlib context lazily here, instead of in ->new.
48 # Deflate contexts are memory-intensive and this object may
49 # be sitting in the Qspawn limiter queue for a while.
50 my $gz = $self->{gz} //= do {
51 my ($g, $err) = Compress::Raw::Zlib::Deflate->new(%OPT);
52 $err == Z_OK or die "Deflate->new failed: $err";
55 my $zbuf = delete($self->{zbuf});
56 if (defined $_[1]) { # my $buf = $_[1];
57 my $err = $gz->deflate($_[1], $zbuf);
58 die "gzip->deflate: $err" if $err != Z_OK;
59 return $zbuf if length($zbuf) >= 8192;
61 $self->{zbuf} = $zbuf;
63 } else { # undef == EOF
64 my $err = $gz->flush($zbuf, Z_FINISH);
65 die "gzip->flush: $err" if $err != Z_OK;
71 # my $ret = bytes::length($_[1]); # XXX does anybody care?
72 $_[0]->{fh}->write(translate($_[0], $_[1]));
75 # similar to ->translate; use this when we're sure we know we have
76 # more data to buffer after this
78 my $self = $_[0]; # $_[1] => input
79 my $err = $self->{gz}->deflate($_[1], $self->{zbuf});
80 die "gzip->deflate: $err" if $err != Z_OK;
84 # flushes and returns the final bit of gzipped data
86 my $self = $_[0]; # $_[1] => final input (optional)
87 my $zbuf = delete $self->{zbuf};
88 my $gz = delete $self->{gz};
91 $err = $gz->deflate($_[1], $zbuf);
92 die "gzip->deflate: $err" if $err != Z_OK;
94 $err = $gz->flush($zbuf, Z_FINISH);
95 die "gzip->flush: $err" if $err != Z_OK;
101 my $fh = delete $self->{fh};
102 $fh->write(zflush($self));