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 = <<"";
HDR\r
OVER\r
+my $have_deflate;
my $EXPMAP; # fd -> [ idle_time, $self ]
my $expt;
our $EXPTIME = 180; # 3 minutes
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}) };
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 ($;$) {
'.'
}
-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 ($;$) {
} 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} ||= [];
$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];
# 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;
($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;