From 0ab5c363a69702e586b7ef06be3ebff3e78656b7 Mon Sep 17 00:00:00 2001
From: Eric Wong <e@80x24.org>
Date: Wed, 3 Jul 2019 01:05:10 +0000
Subject: Net::NNTP: support COMPRESS DEFLATE (RFC8054)

NNTP compression reduces bandwidth use significantly and is
supported in current versions of INN.

It is specified in https://tools.ietf.org/html/rfc8054

Tested on news.gmane.org (running INN) with and without STARTTLS.
---
 lib/Net/NNTP/Deflate.pm | 128 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 128 insertions(+)
 create mode 100644 lib/Net/NNTP/Deflate.pm

(limited to 'lib/Net/NNTP/Deflate.pm')

diff --git a/lib/Net/NNTP/Deflate.pm b/lib/Net/NNTP/Deflate.pm
new file mode 100644
index 0000000..90b5685
--- /dev/null
+++ b/lib/Net/NNTP/Deflate.pm
@@ -0,0 +1,128 @@
+# Net::NNTP::Deflate
+#
+# Copyright (C) 2019 Eric Wong <e@80x24.org>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+# support NNTP COMPRESS DEFLATE as specified in RFC 8054.  This
+# is an internal class intended for use by Net::NNTP use, only
+#
+# This is done via subclassing and SUPER.  tie can't seem to work
+# since it doesn't seem to stack and layer with IO::Socket::SSL
+# (which also uses tie).  PerlIO won't work, either, since Net::Cmd
+# depends on sysread/syswrite semantics for timeouts.
+package Net::NNTP::Deflate;
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use Compress::Raw::Zlib;
+use base qw(Net::NNTP);
+my %ZOPT = ( -WindowBits => -15, -AppendOutput => 1 );
+use Errno qw(ECONNRESET);
+
+sub compression { 'DEFLATE' }
+
+sub wrap {
+  my ($class, $self) = @_;
+  my ($zin, $zout, $err);
+
+  ($zin, $err) = Compress::Raw::Zlib::Inflate->new(%ZOPT);
+  $err == Z_OK or die "Inflate->new failed: $err\n";
+  ${*$self}{net_nntp_inflate} = [ $zin, '' ];
+
+  ($zout, $err) = Compress::Raw::Zlib::Deflate->new(%ZOPT);
+  $err == Z_OK or die "Deflate->new failed: $err\n";
+  ${*$self}{net_nntp_deflate} = [ $zout, '', 0 ];
+
+  # We need to capture these methods now, otherwise tied calls via
+  # IO::Socket::SSL::SSL_HANDLE::* will infinitely recurse.
+  # XXX sysread/syswrite are obviously needed for wrapping,
+  # but I don't understand why close and fileno wrappers are needed,
+  # but infinite recursion ensues without them :<
+  for my $m (qw(sysread syswrite close fileno)) {
+    ${*$self}{"net_nntp_$m"} = $self->can($m);
+  }
+
+  $class .= 'SSL' if $self->isa('IO::Socket::SSL');
+  bless $self, $class;
+}
+
+sub fileno {
+  my $self = shift;
+  ${*$self}{net_nntp_fileno}->($self);
+}
+
+sub close {
+  my $self = shift;
+  ${*$self}{net_nntp_close}->($self);
+}
+
+sub syswrite {
+  my ($self, undef, $len, $off) = @_;
+  my $de = ${*$self}{net_nntp_deflate};
+  my $zout = $de->[0];
+
+  $off = 0 unless defined($off);
+  $len = bytes::length($_[1]) unless defined($len);
+
+  my $err = $zout->deflate(substr($_[1], $off, $len), $de->[1]);
+  $err == Z_OK or die "->deflate failed: $err";
+
+  $err = $zout->flush($de->[1], Z_PARTIAL_FLUSH);
+  $err == Z_OK or die "->flush failed: $err";
+
+  my $olen = length($de->[1]);
+  my $w = ${*$self}{net_nntp_syswrite}->($self, $de->[1], $olen, $de->[2]);
+  defined($w) or return;
+
+  if ($olen == $w) { # all done!
+    $de->[1] = '';
+    $de->[2] = 0;
+  }
+  else { # try again, later
+    $de->[2] += $w;
+  }
+
+  $len;
+}
+
+# note: only intended for Net::Cmd use, so returning extra data
+# beyond $len won't matter
+sub sysread {
+  my ($self, undef, $len, $off) = @_;
+
+  if (!defined($off) || $off != length($_[1])) {
+    die __PACKAGE__.'::sysread is only intended for Net::Cmd use';
+  }
+
+  my $in = ${*$self}{net_nntp_inflate};
+
+  while (1) {
+    my $ioff = length($in->[1]);
+    my $r = ${*$self}{net_nntp_sysread}->($self, $in->[1], $len, $ioff);
+    $r or return $r; # $r may be undef or 0
+
+    my $err = $in->[0]->inflate($in->[1], $_[1]); # consumes $in->[1]
+    if ($err == Z_OK) {
+      $r = length($_[1]);
+      return $r if $r;
+      next;
+    }
+
+    return 0 if $err == Z_STREAM_END;
+
+    # some other error from ->inflate, probably not recoverable
+    warn "Error: $err from ".ref($in->[0])."::inflate\n";
+    $! = ECONNRESET;
+    return;
+  }
+}
+
+package Net::NNTP::DeflateSSL;
+use base qw(Net::NNTP::Deflate Net::NNTP::_SSL);
+
+1;
-- 
cgit v1.2.3-24-ge0c7