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);
use PublicInbox::DS qw(now);
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 = <<"";
OVER\r
my $have_deflate;
-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;
-}
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 = eval {
- no strict 'refs';
- *{'cmd_'.lc($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);
my $arg = shift @args;
$arg =~ tr/A-Z./a-z_/;
$arg = "list_$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 ($$;$) {
$beg = $min if ($beg < $min);
$end = $max if ($end > $max);
return '420 No article(s) selected' if ($beg > $end);
- [ $beg, $end ];
+ [ \$beg, $end ];
}
sub long_response ($$) {
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
my ($beg, $end) = @$r;
more($self, $xhdr ? r221 : r225);
long_response($self, sub {
- my $r = $mm->msg_range(\$beg, $end);
+ my $r = $mm->msg_range($beg, $end);
@$r or return;
more($self, join("\r\n", map {
"$_->[0] <$_->[1]>"
my ($beg, $end) = @$r;
more($self, $xhdr ? r221 : r225);
long_response($self, sub {
- my $r = $mm->msg_range(\$beg, $end);
+ my $r = $mm->msg_range($beg, $end);
@$r or return;
more($self, join("\r\n", map {
my $num = $_->[0];
return $r unless ref $r;
my ($beg, $end) = @$r;
more($self, $xhdr ? r221 : r225);
- my $cur = $beg;
+ my $cur = $$beg;
long_response($self, sub {
my $msgs = $over->query_xover($cur, $end);
my $nr = scalar @$msgs or return;
more($self, '224 Overview information follows');
long_response($self, sub {
- my $h = over_header_for($over, $beg, 'references');
- more($self, "$beg $h") if defined($h);
- $beg++ < $end;
+ my $h = over_header_for($over, $$beg, 'references');
+ more($self, "$$beg $h") if defined($h);
+ $$beg++ < $end;
});
}
my $r = get_range($self, $range);
return $r unless ref $r;
my ($beg, $end) = @$r;
- more($self, "224 Overview information follows for $beg to $end");
+ more($self, "224 Overview information follows for $$beg to $end");
my $over = $self->{ng}->over;
- my $cur = $beg;
+ my $cur = $$beg;
long_response($self, sub {
my $msgs = $over->query_xover($cur, $end);
my $nr = scalar @$msgs or return;
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
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