X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FNNTP.pm;h=39e2f88e5135d4e9bb08ed65e1a54b96a722c6f2;hb=906393b801050e303d2ec2a660c85de4a5fa4740;hp=95ac7d5fd7ccaddf2dbf505241e006fdf1251ec9;hpb=59a7f5c908dc0e898e8925bcd06c5e526f86d063;p=public-inbox.git
diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 95ac7d5f..39e2f88e 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -1,4 +1,4 @@
-# Copyright (C) 2015-2019 all contributors
+# Copyright (C) 2015-2020 all contributors
# License: AGPL-3.0+
#
# Each instance of this represents a NNTP client socket
@@ -7,7 +7,7 @@ use strict;
use warnings;
use base qw(PublicInbox::DS);
use fields qw(nntpd article ng long_cb);
-use PublicInbox::MID qw(mid_escape);
+use PublicInbox::MID qw(mid_escape $MID_EXTRACT);
use Email::Simple;
use POSIX qw(strftime);
use PublicInbox::DS qw(now);
@@ -24,7 +24,7 @@ use constant {
};
use PublicInbox::Syscall qw(EPOLLIN EPOLLONESHOT);
use Errno qw(EAGAIN);
-
+my $ONE_MSGID = qr/\A$MID_EXTRACT\z/;
my @OVERVIEW = qw(Subject From Date Message-ID References);
my $OVERVIEW_FMT = join(":\r\n", @OVERVIEW, qw(Bytes Lines), '') .
"Xref:full\r\n";
@@ -180,6 +180,22 @@ sub cmd_list ($;$$) {
'.'
}
+sub listgroup_range_i {
+ my ($self, $beg, $end) = @_;
+ my $r = $self->{ng}->mm->msg_range($beg, $end, 'num');
+ scalar(@$r) or return;
+ more($self, join("\r\n", map { $_->[0] } @$r));
+ 1;
+}
+
+sub listgroup_all_i {
+ my ($self, $num) = @_;
+ my $ary = $self->{ng}->mm->ids_after($num);
+ scalar(@$ary) or return;
+ more($self, join("\r\n", @$ary));
+ 1;
+}
+
sub cmd_listgroup ($;$$) {
my ($self, $group, $range) = @_;
if (defined $group) {
@@ -187,26 +203,13 @@ sub cmd_listgroup ($;$$) {
return $res if ($res !~ /\A211 /);
more($self, $res);
}
- my $ng = $self->{ng} or return '412 no newsgroup selected';
- my $mm = $ng->mm;
+ $self->{ng} or return '412 no newsgroup selected';
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;
- });
+ long_response($self, \&listgroup_range_i, @$r);
} 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;
- });
+ long_response($self, \&listgroup_all_i, \(my $num = 0));
}
}
@@ -217,16 +220,17 @@ sub parse_time ($$;$) {
$gmt =~ /\A(?:UTC|GMT)\z/i or die "GM invalid: $gmt";
$gmt = 1;
}
- my @now = $gmt ? gmtime : localtime;
my ($YYYY, $MM, $DD);
if (bytes::length($date) == 8) { # RFC 3977 allows YYYYMMDD
($YYYY, $MM, $DD) = unpack('A4A2A2', $date);
} else { # legacy clients send YYMMDD
- ($YYYY, $MM, $DD) = unpack('A2A2A2', $date);
+ my $YY;
+ ($YY, $MM, $DD) = unpack('A2A2A2', $date);
+ my @now = $gmt ? gmtime : localtime;
my $cur_year = $now[5] + 1900;
- if ($YYYY > $cur_year) {
- $YYYY += int($cur_year / 1000) * 1000 - 100;
- }
+ my $cur_cent = int($cur_year / 100) * 100;
+ $YYYY = (($YY + $cur_cent) > $cur_year) ?
+ ($YY + 1900) : ($YY + $cur_cent);
}
if ($gmt) {
timegm($ss, $mm, $hh, $DD, $MM - 1, $YYYY);
@@ -287,6 +291,26 @@ sub ngpat2re (;$) {
$_[0] = qr/\A(?:$_[0])\z/;
}
+sub newnews_i {
+ my ($self, $overs, $ts, $prev) = @_;
+ my $over = $overs->[0];
+ my $msgs = $over->query_ts($ts, $$prev);
+ if (scalar @$msgs) {
+ more($self, '<' .
+ join(">\r\n<", map { $_->mid } @$msgs ).
+ '>');
+ $$prev = $msgs->[-1]->{num};
+ } else {
+ shift @$overs;
+ if (@$overs) { # continue onto next newsgroup
+ $$prev = 0;
+ return 1;
+ } else { # break out of the long response.
+ return;
+ }
+ }
+}
+
sub cmd_newnews ($$$$;$$) {
my ($self, $newsgroups, $date, $time, $gmt, $dists) = @_;
my $ts = eval { parse_time($date, $time, $gmt) };
@@ -295,34 +319,17 @@ sub cmd_newnews ($$$$;$$) {
my ($keep, $skip) = split('!', $newsgroups, 2);
ngpat2re($keep);
ngpat2re($skip);
- my @over;
+ my @overs;
foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
$ng->{newsgroup} =~ $keep or next;
$ng->{newsgroup} =~ $skip and next;
my $over = $ng->over or next;
- push @over, $over;
+ push @overs, $over;
};
- return '.' unless @over;
+ return '.' unless @overs;
my $prev = 0;
- long_response($self, sub {
- my $over = $over[0];
- my $msgs = $over->query_ts($ts, $prev);
- if (scalar @$msgs) {
- more($self, '<' .
- join(">\r\n<", map { $_->mid } @$msgs ).
- '>');
- $prev = $msgs->[-1]->{num};
- } else {
- shift @over;
- if (@over) { # continue onto next newsgroup
- $prev = 0;
- return 1;
- } else { # break out of the long response.
- return;
- }
- }
- });
+ long_response($self, \&newnews_i, \@overs, $ts, \$prev);
}
sub cmd_group ($$) {
@@ -416,10 +423,7 @@ sub set_nntp_headers ($$$$$) {
$hdr->header_set('Message-ID', $mid0);
my @alt = $hdr->header('X-Alt-Message-ID');
my %seen = map { $_ => 1 } (@alt, $mid0);
- foreach my $m (@mids) {
- next if $seen{$m}++;
- push @alt, $m;
- }
+ push(@alt, grep { !$seen{$_}++ } @mids);
$hdr->header_set('X-Alt-Message-ID', @alt);
}
@@ -446,7 +450,7 @@ sub art_lookup ($$$) {
$err = '423 no such article number in this group';
$n = int($art);
goto find_mid;
- } elsif ($art =~ /\A<([^>]+)>\z/) {
+ } elsif ($art =~ $ONE_MSGID) {
$mid = $1;
$err = r430;
$n = $ng->mm->num_for($mid) if $ng;
@@ -589,12 +593,11 @@ sub get_range ($$) {
sub long_step {
my ($self) = @_;
# wbuf is unset or empty, here; {long} may add to it
- my ($cb, $t0, @args) = @{$self->{long_cb}};
+ my ($fd, $cb, $t0, @args) = @{$self->{long_cb}};
my $more = eval { $cb->($self, @args) };
if ($@ || !$self->{sock}) { # something bad happened...
delete $self->{long_cb};
my $elapsed = now() - $t0;
- my $fd = fileno($self->{sock});
if ($@) {
err($self,
"%s during long response[$fd] - %0.6f",
@@ -610,20 +613,19 @@ sub long_step {
# each other's data
$self->zflush;
- # no recursion, schedule another call ASAP
- # but only after all pending writes are done
- my $wbuf = $self->{wbuf} ||= [];
- push @$wbuf, \&long_step;
+ # no recursion, schedule another call ASAP, but only after
+ # all pending writes are done. autovivify wbuf:
+ my $new_size = push(@{$self->{wbuf}}, \&long_step);
# wbuf may be populated by $cb, no need to rearm if so:
- $self->requeue if scalar(@$wbuf) == 1;
+ $self->requeue if $new_size == 1;
} else { # all done!
delete $self->{long_cb};
res($self, '.');
my $elapsed = now() - $t0;
my $fd = fileno($self->{sock});
out($self, " deferred[$fd] done - %0.6f", $elapsed);
- my $wbuf = $self->{wbuf};
+ my $wbuf = $self->{wbuf}; # do NOT autovivify
$self->requeue unless $wbuf && @$wbuf;
}
}
@@ -631,19 +633,27 @@ sub long_step {
sub long_response ($$;@) {
my ($self, $cb, @args) = @_; # cb returns true if more, false if done
- $self->{sock} or return;
+ my $sock = $self->{sock} or return;
# make sure we disable reading during a long response,
# clients should not be sending us stuff and making us do more
# work while we are stream a response to them
- $self->{long_cb} = [ $cb, now(), @args ];
+ $self->{long_cb} = [ fileno($sock), $cb, now(), @args ];
long_step($self); # kick off!
undef;
}
+sub hdr_msgid_range_i {
+ my ($self, $beg, $end) = @_;
+ my $r = $self->{ng}->mm->msg_range($beg, $end);
+ @$r or return;
+ more($self, join("\r\n", map { "$_->[0] <$_->[1]>" } @$r));
+ 1;
+}
+
sub hdr_message_id ($$$) { # optimize XHDR Message-ID [range] for slrnpull.
my ($self, $xhdr, $range) = @_;
- if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
+ if (defined $range && $range =~ $ONE_MSGID) {
my ($ng, $n) = mid_lookup($self, $1);
return r430 unless $n;
hdr_mid_response($self, $xhdr, $ng, $n, $range, $range);
@@ -651,17 +661,8 @@ sub hdr_message_id ($$$) { # optimize XHDR Message-ID [range] for slrnpull.
$range = $self->{article} unless defined $range;
my $r = get_range($self, $range);
return $r unless ref $r;
- my $mm = $self->{ng}->mm;
- my ($beg, $end) = @$r;
more($self, $xhdr ? r221 : r225);
- long_response($self, sub {
- my $r = $mm->msg_range($beg, $end);
- @$r or return;
- more($self, join("\r\n", map {
- "$_->[0] <$_->[1]>"
- } @$r));
- 1;
- });
+ long_response($self, \&hdr_msgid_range_i, @$r);
}
}
@@ -695,7 +696,7 @@ sub xref_range_i {
sub hdr_xref ($$$) { # optimize XHDR Xref [range] for rtin
my ($self, $xhdr, $range) = @_;
- if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
+ if (defined $range && $range =~ $ONE_MSGID) {
my $mid = $1;
my ($ng, $n) = mid_lookup($self, $mid);
return r430 unless $n;
@@ -713,11 +714,11 @@ sub hdr_xref ($$$) { # optimize XHDR Xref [range] for rtin
sub over_header_for {
my ($over, $num, $field) = @_;
my $smsg = $over->get_art($num) or return;
- return PublicInbox::SearchMsg::date($smsg) if $field eq 'date';
+ return PublicInbox::Smsg::date($smsg) if $field eq 'date';
$smsg->{$field};
}
-sub searchmsg_range_i {
+sub smsg_range_i {
my ($self, $beg, $end, $field) = @_;
my $over = $self->{ng}->over;
my $msgs = $over->query_xover($$beg, $end);
@@ -731,9 +732,9 @@ sub searchmsg_range_i {
$$beg = $msgs->[-1]->{num} + 1;
}
-sub hdr_searchmsg ($$$$) {
+sub hdr_smsg ($$$$) {
my ($self, $xhdr, $field, $range) = @_;
- if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
+ if (defined $range && $range =~ $ONE_MSGID) {
my ($ng, $n) = mid_lookup($self, $1);
return r430 unless defined $n;
my $v = over_header_for($ng->over, $n, $field);
@@ -743,7 +744,7 @@ sub hdr_searchmsg ($$$$) {
my $r = get_range($self, $range);
return $r unless ref $r;
more($self, $xhdr ? r221 : r225);
- long_response($self, \&searchmsg_range_i, @$r, $field);
+ long_response($self, \&smsg_range_i, @$r, $field);
}
}
@@ -756,9 +757,9 @@ sub do_hdr ($$$;$) {
hdr_xref($self, $xhdr, $range);
} elsif ($sub =~ /\A(?:subject|references|date|from|to|cc|
bytes|lines)\z/x) {
- hdr_searchmsg($self, $xhdr, $sub, $range);
+ hdr_smsg($self, $xhdr, $sub, $range);
} elsif ($sub =~ /\A:(bytes|lines)\z/) {
- hdr_searchmsg($self, $xhdr, $1, $range);
+ hdr_smsg($self, $xhdr, $1, $range);
} else {
$xhdr ? (r221 . "\r\n.") : "503 HDR not permitted on $header";
}
@@ -830,7 +831,7 @@ sub over_line ($$$$) {
my $s = join("\t", $num,
$smsg->{subject},
$smsg->{from},
- PublicInbox::SearchMsg::date($smsg),
+ PublicInbox::Smsg::date($smsg),
"<$smsg->{mid}>",
$smsg->{references},
$smsg->{bytes},
@@ -842,7 +843,7 @@ sub over_line ($$$$) {
sub cmd_over ($;$) {
my ($self, $range) = @_;
- if ($range && $range =~ /\A<(.+)>\z/) {
+ if ($range && $range =~ $ONE_MSGID) {
my ($ng, $n) = mid_lookup($self, $1);
defined $n or return r430;
my $smsg = $ng->over->get_art($n) or return r430;
@@ -858,6 +859,19 @@ sub cmd_over ($;$) {
}
}
+sub xover_i {
+ my ($self, $beg, $end) = @_;
+ my $ng = $self->{ng};
+ my $msgs = $ng->over->query_xover($$beg, $end);
+ my $nr = scalar @$msgs or return;
+
+ # OVERVIEW.FMT
+ more($self, join("\r\n", map {
+ over_line($self, $ng, $_->{num}, $_);
+ } @$msgs));
+ $$beg = $msgs->[-1]->{num} + 1;
+}
+
sub cmd_xover ($;$) {
my ($self, $range) = @_;
$range = $self->{article} unless defined $range;
@@ -865,18 +879,7 @@ sub cmd_xover ($;$) {
return $r unless ref $r;
my ($beg, $end) = @$r;
more($self, "224 Overview information follows for $$beg to $end");
- my $over = $self->{ng}->over;
- my $cur = $$beg;
- long_response($self, sub {
- my $msgs = $over->query_xover($cur, $end);
- my $nr = scalar @$msgs or return;
-
- # OVERVIEW.FMT
- more($self, join("\r\n", map {
- over_line($self, $self->{ng}, $_->{num}, $_);
- } @$msgs));
- $cur = $msgs->[-1]->{num} + 1;
- });
+ long_response($self, \&xover_i, @$r);
}
sub compressed { undef }
@@ -908,7 +911,7 @@ sub zflush {} # overridden by NNTPdeflate
sub cmd_xpath ($$) {
my ($self, $mid) = @_;
- return r501 unless $mid =~ /\A<(.+)>\z/;
+ return r501 unless $mid =~ $ONE_MSGID;
$mid = $1;
my @paths;
foreach my $ng (values %{$self->{nntpd}->{groups}}) {