nntp: add support for CAPABILITIES command

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

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 5a886a3c32be100b0d24f393b8792846d0fcfd24..d106e3158e32f73396c33585bbebf9772849456e 100644 (file)
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -6,7 +6,7 @@ package PublicInbox::NNTP;
 use strict;
 use warnings;
 use base qw(PublicInbox::DS);
-use fields qw(nntpd article rbuf ng);
+use fields qw(nntpd article ng);
 use PublicInbox::Search;
 use PublicInbox::Msgmap;
 use PublicInbox::MID qw(mid_escape);
@@ -31,27 +31,18 @@ my @OVERVIEW = qw(Subject From Date Message-ID References Xref);
 my $OVERVIEW_FMT = join(":\r\n", @OVERVIEW, qw(Bytes Lines)) . ":\r\n";
 my $LIST_HEADERS = join("\r\n", @OVERVIEW,
                        qw(:bytes :lines Xref To Cc)) . "\r\n";
-
-# disable commands with easy DoS potential:
-my %DISABLED; # = map { $_ => 1 } qw(xover list_overview_fmt newnews xhdr);
+my $CAPABILITIES = <<"";
+101 Capability list:\r
+VERSION 2\r
+READER\r
+NEWNEWS\r
+LIST ACTIVE ACTIVE.TIMES NEWSGROUPS OVERVIEW.FMT\r
+HDR\r
+OVER\r
 
 my $EXPMAP; # fd -> [ idle_time, $self ]
 my $expt;
 our $EXPTIME = 180; # 3 minutes
-my $nextt;
-
-my $nextq = [];
-sub next_tick () {
-       $nextt = undef;
-       my $q = $nextq;
-       $nextq = [];
-       event_step($_) for @$q;
-}
-
-sub requeue ($) {
-       push @$nextq, $_[0];
-       $nextt ||= PublicInbox::EvCleanup::asap(*next_tick);
-}
 
 sub update_idle_time ($) {
        my ($self) = @_;
@@ -64,14 +55,11 @@ sub expire_old () {
        my $exp = $EXPTIME;
        my $old = $now - $exp;
        my $nr = 0;
-       my $closed = 0;
        my %new;
        while (my ($fd, $v) = each %$EXPMAP) {
                my ($idle_time, $nntp) = @$v;
                if ($idle_time < $old) {
-                       if ($nntp->shutdn) {
-                               $closed++;
-                       } else {
+                       if (!$nntp->shutdn) {
                                ++$nr;
                                $new{$fd} = $v;
                        }
@@ -81,14 +69,7 @@ sub expire_old () {
                }
        }
        $EXPMAP = \%new;
-       if ($nr) {
-               $expt = PublicInbox::EvCleanup::later(*expire_old);
-       } else {
-               $expt = undef;
-               # noop to kick outselves out of the loop ASAP so descriptors
-               # really get closed
-               PublicInbox::EvCleanup::asap(sub {}) if $closed;
-       }
+       $expt = PublicInbox::EvCleanup::later(*expire_old) if $nr;
 }
 
 sub greet ($) { $_[0]->write($_[0]->{nntpd}->{greet}) };
@@ -99,7 +80,8 @@ sub new ($$$) {
        my $ev = EPOLLIN;
        my $wbuf;
        if (ref($sock) eq 'IO::Socket::SSL' && !$sock->accept_SSL) {
-               $ev = PublicInbox::TLS::epollbit() or return CORE::close($sock);
+               return CORE::close($sock) if $! != EAGAIN;
+               $ev = PublicInbox::TLS::epollbit();
                $wbuf = [ \&PublicInbox::DS::accept_tls_step, \&greet ];
        }
        $self->SUPER::new($sock, $ev | EPOLLONESHOT);
@@ -128,10 +110,9 @@ sub process_line ($$) {
        my ($self, $l) = @_;
        my ($req, @args) = split(/[ \t]/, $l);
        return 1 unless defined($req); # skip blank line
-       $req = lc($req);
        $req = eval {
                no strict 'refs';
-               $req = $DISABLED{$req} ? undef : *{'cmd_'.$req}{CODE};
+               *{'cmd_'.lc($req)}{CODE};
        };
        return res($self, '500 command not recognized') unless $req;
        return res($self, r501) unless args_ok($req, scalar @args);
@@ -148,6 +129,17 @@ sub process_line ($$) {
        res($self, $res);
 }
 
+# The keyword argument is not used (rfc3977 5.2.2)
+sub cmd_capabilities ($;$) {
+       my ($self, undef) = @_;
+       my $res = $CAPABILITIES;
+       if (ref($self->{sock}) ne 'IO::Socket::SSL' &&
+                       $self->{nntpd}->{accept_tls}) {
+               $res .= "STARTTLS\r\n";
+       }
+       $res .= '.';
+}
+
 sub cmd_mode ($$) {
        my ($self, $arg) = @_;
        $arg = uc $arg;
@@ -210,7 +202,6 @@ sub cmd_list ($;$$) {
                my $arg = shift @args;
                $arg =~ tr/A-Z./a-z_/;
                $arg = "list_$arg";
-               return r501 if $DISABLED{$arg};
 
                $arg = eval {
                        no strict 'refs';
@@ -654,12 +645,12 @@ sub long_response ($$) {
                        push @$wbuf, $long_cb;
 
                        # wbuf may be populated by $cb, no need to rearm if so:
-                       requeue($self) if scalar(@$wbuf) == 1;
+                       $self->requeue if scalar(@$wbuf) == 1;
                } else { # all done!
                        $long_cb = undef;
                        res($self, '.');
                        out($self, " deferred[$fd] done - %0.6f", now() - $t0);
-                       requeue($self) unless $self->{wbuf};
+                       $self->requeue unless $self->{wbuf};
                }
        };
        $self->write($long_cb); # kick off!
@@ -914,7 +905,7 @@ sub cmd_starttls ($) {
                return '580 can not initiate TLS negotiation';
        res($self, '382 Continue with TLS negotiation');
        $self->{sock} = IO::Socket::SSL->start_SSL($sock, %$opt);
-       requeue($self) if PublicInbox::DS::accept_tls_step($self);
+       $self->requeue if PublicInbox::DS::accept_tls_step($self);
        undef;
 }
 
@@ -984,16 +975,12 @@ sub event_step {
        return $self->close if $r < 0;
        my $len = bytes::length($$rbuf);
        return $self->close if ($len >= LINE_MAX);
-       if ($len) {
-               $self->{rbuf} = $rbuf;
-       } else {
-               delete $self->{rbuf};
-       }
+       $self->rbuf_idle($rbuf);
        update_idle_time($self);
 
        # maybe there's more pipelined data, or we'll have
        # to register it for socket-readiness notifications
-       requeue($self) unless $self->{wbuf};
+       $self->requeue unless $self->{wbuf};
 }
 
 sub not_idle_long ($$) {