# Qspawn filter
package PublicInbox::GzipFilter;
use strict;
+use parent qw(Exporter);
use Compress::Raw::Zlib qw(Z_FINISH Z_OK);
+our @EXPORT_OK = qw(gzf_maybe);
my %OPT = (-WindowBits => 15 + 16, -AppendOutput => 1);
+my @GZIP_HDRS = qw(Vary Accept-Encoding Content-Encoding gzip);
sub new { bless {}, shift }
$self
}
+# returns `0' and not `undef' on failure (see Www*Stream)
+sub gzf_maybe ($$) {
+ my ($res_hdr, $env) = @_;
+ return 0 if (($env->{HTTP_ACCEPT_ENCODING}) // '') !~ /\bgzip\b/;
+ my ($gz, $err) = Compress::Raw::Zlib::Deflate->new(%OPT);
+ return 0 if $err != Z_OK;
+
+ # in case Plack::Middleware::Deflater is loaded:
+ $env->{'plack.skip-deflater'} = 1;
+ push @$res_hdr, @GZIP_HDRS;
+ bless { gz => $gz }, __PACKAGE__;
+}
+
+sub gzip_or_die () {
+ my ($gz, $err) = Compress::Raw::Zlib::Deflate->new(%OPT);
+ $err == Z_OK or die "Deflate->new failed: $err";
+ $gz;
+}
+
# for GetlineBody (via Qspawn) when NOT using $env->{'pi-httpd.async'}
+# Also used for ->getline callbacks
sub translate ($$) {
- my $self = $_[0];
+ my $self = $_[0]; # $_[1] => input
# allocate the zlib context lazily here, instead of in ->new.
# Deflate contexts are memory-intensive and this object may
# be sitting in the Qspawn limiter queue for a while.
- my $gz = $self->{gz} //= do {
- my ($g, $err) = Compress::Raw::Zlib::Deflate->new(%OPT);
- $err == Z_OK or die "Deflate->new failed: $err";
- $g;
- };
+ my $gz = $self->{gz} //= gzip_or_die();
my $zbuf = delete($self->{zbuf});
if (defined $_[1]) { # my $buf = $_[1];
my $err = $gz->deflate($_[1], $zbuf);
$_[0]->{fh}->write(translate($_[0], $_[1]));
}
+# similar to ->translate; use this when we're sure we know we have
+# more data to buffer after this
+sub zmore {
+ my $self = $_[0]; # $_[1] => input
+ my $err = $self->{gz}->deflate($_[1], $self->{zbuf});
+ die "gzip->deflate: $err" if $err != Z_OK;
+ '';
+}
+
+# flushes and returns the final bit of gzipped data
+sub zflush ($;$) {
+ my $self = $_[0]; # $_[1] => final input (optional)
+ my $zbuf = delete $self->{zbuf};
+ my $gz = delete $self->{gz};
+ my $err;
+ if (defined $_[1]) {
+ $err = $gz->deflate($_[1], $zbuf);
+ die "gzip->deflate: $err" if $err != Z_OK;
+ }
+ $err = $gz->flush($zbuf, Z_FINISH);
+ die "gzip->flush: $err" if $err != Z_OK;
+ $zbuf;
+}
+
sub close {
my ($self) = @_;
my $fh = delete $self->{fh};
- $fh->write(translate($self, undef));
+ $fh->write(zflush($self));
$fh->close;
}