-# Copyright (C) 2015-2019 all contributors <meta@public-inbox.org>
+# Copyright (C) 2015-2020 all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
#
# Each instance of this represents a NNTP client socket
'.'
}
+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) {
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));
}
}
$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);
$_[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) };
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 ($$) {
$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);
}
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",
# 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;
}
}
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) = @_;
$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);
}
}
undef;
}
+sub xrover_i {
+ my ($self, $beg, $end) = @_;
+ my $h = over_header_for($self->{ng}->over, $$beg, 'references');
+ more($self, "$$beg $h") if defined($h);
+ $$beg++ < $end;
+}
+
sub cmd_xrover ($;$) {
my ($self, $range) = @_;
my $ng = $self->{ng} or return '412 no newsgroup selected';
$range = $self->{article} unless defined $range;
my $r = get_range($self, $range);
return $r unless ref $r;
- my ($beg, $end) = @$r;
- my $mm = $ng->mm;
- my $over = $ng->over;
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;
- });
+ long_response($self, \&xrover_i, @$r);
}
sub over_line ($$$$) {
}
}
+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;
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 }