nntp: fix LIST OVERVIEW.FMT ordering and format

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

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 631fd3c73f80329e5f01c889e956328854c795bc..800ce9265268eec77b240acfee66ecb82c74ca99 100644 (file)
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -14,12 +14,13 @@ use PublicInbox::Git;
 require PublicInbox::EvCleanup;
 use Email::Simple;
 use POSIX qw(strftime);
-PublicInbox::DS->import(qw(now));
+use PublicInbox::DS 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)',
@@ -28,8 +29,9 @@ use constant {
 use PublicInbox::Syscall qw(EPOLLIN EPOLLONESHOT);
 use Errno qw(EAGAIN);
 
-my @OVERVIEW = qw(Subject From Date Message-ID References Xref);
-my $OVERVIEW_FMT = join(":\r\n", @OVERVIEW, qw(Bytes Lines)) . ":\r\n";
+my @OVERVIEW = qw(Subject From Date Message-ID References);
+my $OVERVIEW_FMT = join(":\r\n", @OVERVIEW, qw(Bytes Lines), '') .
+               "Xref:full\r\n";
 my $LIST_HEADERS = join("\r\n", @OVERVIEW,
                        qw(:bytes :lines Xref To Cc)) . "\r\n";
 my $CAPABILITIES = <<"";
@@ -41,6 +43,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
@@ -55,22 +58,20 @@ sub expire_old () {
        my $now = now();
        my $exp = $EXPTIME;
        my $old = $now - $exp;
-       my $nr = 0;
        my %new;
        while (my ($fd, $v) = each %$EXPMAP) {
                my ($idle_time, $nntp) = @$v;
                if ($idle_time < $old) {
                        if (!$nntp->shutdn) {
-                               ++$nr;
                                $new{$fd} = $v;
                        }
                } else {
-                       ++$nr;
                        $new{$fd} = $v;
                }
        }
        $EXPMAP = \%new;
-       $expt = PublicInbox::EvCleanup::later(*expire_old) if $nr;
+       $expt = scalar(keys %new) ? PublicInbox::EvCleanup::later(*expire_old)
+                                 : undef;
 }
 
 sub greet ($) { $_[0]->write($_[0]->{nntpd}->{greet}) };
@@ -640,6 +641,11 @@ sub long_response ($$) {
                } elsif ($more) { # $self->{wbuf}:
                        update_idle_time($self);
 
+                       # COMPRESS users all share the same DEFLATE context.
+                       # Flush it here to ensure clients don't see
+                       # each other's data
+                       $self->zflush;
+
                        # no recursion, schedule another call ASAP
                        # but only after all pending writes are done
                        my $wbuf = $self->{wbuf} ||= [];
@@ -651,7 +657,8 @@ sub long_response ($$) {
                        $long_cb = undef;
                        res($self, '.');
                        out($self, " deferred[$fd] done - %0.6f", now() - $t0);
-                       $self->requeue unless $self->{wbuf};
+                       my $wbuf = $self->{wbuf};
+                       $self->requeue unless $wbuf && @$wbuf;
                }
        };
        $self->write($long_cb); # kick off!
@@ -897,11 +904,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');
@@ -910,6 +919,18 @@ sub cmd_starttls ($) {
        undef;
 }
 
+# RFC 8054
+sub cmd_compress ($$) {
+       my ($self, $alg) = @_;
+       return '503 Only DEFLATE is supported' if uc($alg) ne 'DEFLATE';
+       return r502 if $self->compressed || !$have_deflate;
+       PublicInbox::NNTPdeflate->enable($self);
+       $self->requeue;
+       undef
+}
+
+sub zflush {} # overridden by NNTPdeflate
+
 sub cmd_xpath ($$) {
        my ($self, $mid) = @_;
        return r501 unless $mid =~ /\A<(.+)>\z/;
@@ -997,4 +1018,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;