use warnings;
use base qw(PublicInbox::DS);
use fields qw(nntpd article ng);
-use PublicInbox::Search;
-use PublicInbox::Msgmap;
use PublicInbox::MID qw(mid_escape);
-use PublicInbox::Git;
-require PublicInbox::EvCleanup;
use Email::Simple;
use POSIX qw(strftime);
-PublicInbox::DS->import(qw(now msg_more));
+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)',
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 = <<"";
+101 Capability list:\r
+VERSION 2\r
+READER\r
+NEWNEWS\r
+LIST ACTIVE ACTIVE.TIMES NEWSGROUPS OVERVIEW.FMT\r
+HDR\r
+OVER\r
-# disable commands with easy DoS potential:
-my %DISABLED; # = map { $_ => 1 } qw(xover list_overview_fmt newnews xhdr);
-
-my $EXPMAP; # fd -> [ idle_time, $self ]
-my $expt;
-our $EXPTIME = 180; # 3 minutes
-
-sub update_idle_time ($) {
- my ($self) = @_;
- my $sock = $self->{sock} or return;
- $EXPMAP->{fileno($sock)} = [ now(), $self ];
-}
-
-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;
-}
+my $have_deflate;
sub greet ($) { $_[0]->write($_[0]->{nntpd}->{greet}) };
} else {
greet($self);
}
- update_idle_time($self);
- $expt ||= PublicInbox::EvCleanup::later(*expire_old);
+ $self->update_idle_time;
$self;
}
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};
- };
+ $req = $self->can('cmd_'.lc($req));
return res($self, '500 command not recognized') unless $req;
return res($self, r501) unless args_ok($req, scalar @args);
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;
sub list_overview_fmt ($) {
my ($self) = @_;
- msg_more($self, $OVERVIEW_FMT);
+ $self->msg_more($OVERVIEW_FMT);
}
sub list_headers ($;$) {
my ($self) = @_;
- msg_more($self, $LIST_HEADERS);
+ $self->msg_more($LIST_HEADERS);
}
sub list_active ($;$) {
my $arg = shift @args;
$arg =~ tr/A-Z./a-z_/;
$arg = "list_$arg";
- return r501 if $DISABLED{$arg};
-
- $arg = eval {
- no strict 'refs';
- *{$arg}{CODE};
- };
+ $arg = $self->can($arg);
return r501 unless $arg && args_ok($arg, scalar @args);
more($self, '215 information follows');
$arg->($self, @args);
'.'
}
-sub cmd_listgroup ($;$) {
- my ($self, $group) = @_;
+sub cmd_listgroup ($;$$) {
+ my ($self, $group, $range) = @_;
if (defined $group) {
my $res = cmd_group($self, $group);
return $res if ($res !~ /\A211 /);
more($self, $res);
}
-
- $self->{ng} or return '412 no newsgroup selected';
- my $n = 0;
- long_response($self, sub {
- my $ary = $self->{ng}->mm->ids_after(\$n);
- scalar @$ary or return;
- more($self, join("\r\n", @$ary));
- 1;
- });
+ my $ng = $self->{ng} or return '412 no newsgroup selected';
+ my $mm = $ng->mm;
+ if (defined $range) {
+ my $r = get_range($self, $range);
+ return $r unless ref $r;
+ my ($beg, $end) = @$r;
+ long_response($self, sub {
+ $r = $mm->msg_range(\$beg, $end, 'num');
+ scalar(@$r) or return;
+ more($self, join("\r\n", map { $_->[0] } @$r));
+ 1;
+ });
+ } else { # grab every article number
+ my $n = 0;
+ long_response($self, sub {
+ my $ary = $mm->ids_after(\$n);
+ scalar(@$ary) or return;
+ more($self, join("\r\n", @$ary));
+ 1;
+ });
+ }
}
sub parse_time ($$;$) {
$$msg =~ s/^\./../smg;
$$msg =~ s/(?<!\r)\n/\r\n/sg; # Alpine barfs without this
$$msg .= "\r\n" unless $$msg =~ /\r\n\z/s;
- msg_more($self, $$msg);
+ $self->msg_more($$msg);
'.'
}
# affect messages already in the archive.
$hdr =~ s/^(Message-ID:)[ \t]*\r\n[ \t]+([^\r]+)\r\n/$1 $2\r\n/igsm;
$hdr .= "\r\n" if $body_follows;
- msg_more($self, $hdr);
+ $self->msg_more($hdr);
}
sub cmd_article ($;$) {
out($self, " deferred[$fd] aborted - %0.6f", $diff);
$self->close;
} elsif ($more) { # $self->{wbuf}:
- update_idle_time($self);
+ $self->update_idle_time;
+
+ # 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
$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!
$tmp .= $s->{num} . ' ' . $s->$field . "\r\n";
}
utf8::encode($tmp);
- msg_more($self, $tmp);
+ $self->msg_more($tmp);
$cur = $msgs->[-1]->{num} + 1;
});
}
});
}
+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');
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/;
sub res ($$) { do_write($_[0], $_[1] . "\r\n") }
-sub more ($$) { msg_more($_[0], $_[1] . "\r\n") }
+sub more ($$) { $_[0]->msg_more($_[1] . "\r\n") }
sub do_write ($$) {
my $self = $_[0];
return unless $self->flush_write && $self->{sock};
- update_idle_time($self);
+ $self->update_idle_time;
# 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;
my $off = bytes::length($$rbuf);
$r = $self->do_read($rbuf, LINE_MAX, $off) or return;
}
- while ($r > 0 && $$rbuf =~ s/\A[ \t\r\n]*([^\r\n]*)\r?\n//) {
+ while ($r > 0 && $$rbuf =~ s/\A[ \t]*([^\n]*?)\r?\n//) {
my $line = $1;
return $self->close if $line =~ /[[:cntrl:]]/s;
my $t0 = now();
my $len = bytes::length($$rbuf);
return $self->close if ($len >= LINE_MAX);
$self->rbuf_idle($rbuf);
- update_idle_time($self);
+ $self->update_idle_time;
# maybe there's more pipelined data, or we'll have
# to register it for socket-readiness notifications
$self->requeue unless $self->{wbuf};
}
-sub not_idle_long ($$) {
- my ($self, $now) = @_;
- my $sock = $self->{sock} or return;
- my $ary = $EXPMAP->{fileno($sock)} or return;
- my $exp_at = $ary->[0] + $EXPTIME;
- $exp_at > $now;
-}
-
# for graceful shutdown in PublicInbox::Daemon:
sub busy {
my ($self, $now) = @_;
- ($self->{rbuf} || $self->{wbuf} || not_idle_long($self, $now));
+ ($self->{rbuf} || $self->{wbuf} || $self->not_idle_long($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;