nntp: support COMPRESS DEFLATE per RFC 8054

[public-inbox.git] / lib / PublicInbox / NNTP.pm

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 9b8b81ec66720ec959b7515d3d5e2a3929023508..d6f315bab42a9ed7e0b8b607a3ba6cf01066ef55 100644 (file)
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -18,7 +18,9 @@ PublicInbox::DS->import(qw(now));
 use Digest::SHA qw(sha1_hex);
 use Time::Local qw(timegm timelocal);
 use constant {
+       LINE_MAX => 512, # RFC 977 section 2.3
        r501 => '501 command syntax error',
+       r502 => '502 Command unavailable',
        r221 => '221 Header follows',
        r224 => '224 Overview information follows (multi-line)',
        r225 => '225 Headers follow (multi-line)',
@@ -40,6 +42,7 @@ LIST ACTIVE ACTIVE.TIMES NEWSGROUPS OVERVIEW.FMT\r
 HDR\r
 OVER\r
 
+my $have_deflate;
 my $EXPMAP; # fd -> [ idle_time, $self ]
 my $expt;
 our $EXPTIME = 180; # 3 minutes
@@ -896,11 +899,13 @@ sub cmd_xover ($;$) {
        });
 }
 
+sub compressed { undef }
+
 sub cmd_starttls ($) {
        my ($self) = @_;
        my $sock = $self->{sock} or return;
        # RFC 4642 2.2.1
-       (ref($sock) eq 'IO::Socket::SSL') and return '502 Command unavailable';
+       return r502 if (ref($sock) eq 'IO::Socket::SSL' || $self->compressed);
        my $opt = $self->{nntpd}->{accept_tls} or
                return '580 can not initiate TLS negotiation';
        res($self, '382 Continue with TLS negotiation');
@@ -909,6 +914,17 @@ sub cmd_starttls ($) {
        undef;
 }
 
+# RFC 8054
+sub cmd_compress ($$) {
+       my ($self, $alg) = @_;
+       return '503 Only the DEFLATE is supported' if uc($alg) ne 'DEFLATE';
+       return r502 if $self->compressed || !$have_deflate;
+       res($self, '206 Compression active');
+       PublicInbox::NNTPdeflate->enable($self);
+       $self->requeue;
+       undef
+}
+
 sub cmd_xpath ($$) {
        my ($self, $mid) = @_;
        return r501 unless $mid =~ /\A<(.+)>\z/;
@@ -954,7 +970,6 @@ sub event_step {
        # only read more requests if we've drained the write buffer,
        # otherwise we can be buffering infinitely w/o backpressure
 
-       use constant LINE_MAX => 512; # RFC 977 section 2.3
        my $rbuf = $self->{rbuf} // (\(my $x = ''));
        my $r = 1;
 
@@ -997,4 +1012,10 @@ sub busy {
        ($self->{rbuf} || $self->{wbuf} || not_idle_long($self, $now));
 }
 
+# this is an import to prevent "perl -c" from complaining about fields
+sub import {
+       $have_deflate = eval { require PublicInbox::NNTPdeflate } and
+               $CAPABILITIES .= "COMPRESS DEFLATE\r\n";
+}
+
 1;