From a71cb67a1237c450a9cbbd6738c5af3b73ba4c61 Mon Sep 17 00:00:00 2001
From: Eric Wong <e@yhbt.net>
Date: Sat, 21 Mar 2020 02:03:44 +0000
Subject: qspawn: reinstate filter support, add gzip filter

We'll be supporting gzipped from sqlite3(1) dumps
for altid files in future commits.

In the future (and if we survive), we may replace
Plack::Middleware::Deflater with our own GzipFilter to work
better with asynchronous responses without relying on
memory-intensive anonymous subs.
---
 lib/PublicInbox/GzipFilter.pm | 54 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 54 insertions(+)
 create mode 100644 lib/PublicInbox/GzipFilter.pm

(limited to 'lib/PublicInbox/GzipFilter.pm')

diff --git a/lib/PublicInbox/GzipFilter.pm b/lib/PublicInbox/GzipFilter.pm
new file mode 100644
index 00000000..d883130f
--- /dev/null
+++ b/lib/PublicInbox/GzipFilter.pm
@@ -0,0 +1,54 @@
+# Copyright (C) 2020 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+
+# Qspawn filter
+package PublicInbox::GzipFilter;
+use strict;
+use bytes (); # length
+use Compress::Raw::Zlib qw(Z_FINISH Z_OK);
+my %OPT = (-WindowBits => 15 + 16, -AppendOutput => 1);
+
+sub new {
+	my ($gz, $err) = Compress::Raw::Zlib::Deflate->new(%OPT);
+	$err == Z_OK or die "Deflate->new failed: $err";
+	bless { gz => $gz }, shift;
+}
+
+# for Qspawn if using $env->{'pi-httpd.async'}
+sub attach {
+	my ($self, $fh) = @_;
+	$self->{fh} = $fh;
+	$self
+}
+
+# for GetlineBody (via Qspawn) when NOT using $env->{'pi-httpd.async'}
+sub translate ($$) {
+	my $self = $_[0];
+	my $zbuf = delete($self->{zbuf});
+	if (defined $_[1]) { # my $buf = $_[1];
+		my $err = $self->{gz}->deflate($_[1], $zbuf);
+		die "gzip->deflate: $err" if $err != Z_OK;
+		return $zbuf if length($zbuf) >= 8192;
+
+		$self->{zbuf} = $zbuf;
+		'';
+	} else { # undef == EOF
+		my $err = $self->{gz}->flush($zbuf, Z_FINISH);
+		die "gzip->flush: $err" if $err != Z_OK;
+		$zbuf;
+	}
+}
+
+sub write {
+	# my $ret = bytes::length($_[1]); # XXX does anybody care?
+	$_[0]->{fh}->write(translate($_[0], $_[1]));
+}
+
+sub close {
+	my ($self) = @_;
+	my $fh = delete $self->{fh};
+	$fh->write(translate($self, undef));
+	$fh->close;
+}
+
+1;
-- 
cgit v1.2.3-24-ge0c7