]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/NNTP.pm
nntp: simplify the long_response API
[public-inbox.git] / lib / PublicInbox / NNTP.pm
index 56d08385da0f6a4b924e07ffb01662ad288f0715..e51793505cf515851f7031dc65c982918076f89c 100644 (file)
@@ -1,5 +1,5 @@
-# Copyright (C) 2015 all contributors <meta@public-inbox.org>
-# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+# Copyright (C) 2015-2018 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
 package PublicInbox::NNTP;
@@ -9,12 +9,14 @@ use base qw(Danga::Socket);
 use fields qw(nntpd article rbuf ng long_res);
 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 Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);
-use URI::Escape qw(uri_escape_utf8);
+use Digest::SHA qw(sha1_hex);
+use Time::Local qw(timegm timelocal);
 use constant {
        r501 => '501 command syntax error',
        r221 => '221 Header follows',
@@ -32,14 +34,11 @@ my $LIST_HEADERS = join("\r\n", @OVERVIEW,
                        qw(:bytes :lines Xref To Cc)) . "\r\n";
 
 # disable commands with easy DoS potential:
-# LISTGROUP could get pretty bad, too...
 my %DISABLED; # = map { $_ => 1 } qw(xover list_overview_fmt newnews xhdr);
 
 my $EXPMAP; # fd -> [ idle_time, $self ]
 my $expt;
 our $EXPTIME = 180; # 3 minutes
-my $WEAKEN = {}; # string(nntpd) -> nntpd
-my $weakt;
 my $nextt;
 
 my $nextq = [];
@@ -64,16 +63,6 @@ sub update_idle_time ($) {
        defined $fd and $EXPMAP->{$fd} = [ now(), $self ];
 }
 
-# reduce FD pressure by closing some "git cat-file --batch" processes
-# and unused FDs for msgmap and Xapian indices
-sub weaken_groups () {
-       $weakt = undef;
-       foreach my $nntpd (values %$WEAKEN) {
-               $_->weaken_all foreach (@{$nntpd->{grouplist}});
-       }
-       $WEAKEN = {};
-}
-
 sub expire_old () {
        my $now = now();
        my $exp = $EXPTIME;
@@ -92,15 +81,11 @@ sub expire_old () {
        $EXPMAP = \%new;
        if ($nr) {
                $expt = PublicInbox::EvCleanup::later(*expire_old);
-               weaken_groups();
        } else {
                $expt = undef;
                # noop to kick outselves out of the loop ASAP so descriptors
                # really get closed
                PublicInbox::EvCleanup::asap(sub {});
-
-               # grace period for reaping resources
-               $weakt ||= PublicInbox::EvCleanup::later(*weaken_groups);
        }
 }
 
@@ -113,7 +98,6 @@ sub new ($$$) {
        $self->{rbuf} = '';
        $self->watch_read(1);
        update_idle_time($self);
-       $WEAKEN->{"$nntpd"} = $nntpd;
        $expt ||= PublicInbox::EvCleanup::later(*expire_old);
        $self;
 }
@@ -142,6 +126,7 @@ sub process_line ($$) {
        my $res = eval { $req->($self, @args) };
        my $err = $@;
        if ($err && !$self->{closed}) {
+               local $/ = "\n";
                chomp($l);
                err($self, 'error from: %s (%s)', $l, $err);
                $res = '503 program fault - command not performed';
@@ -239,21 +224,17 @@ sub cmd_listgroup ($;$) {
        }
 
        $self->{ng} or return '412 no newsgroup selected';
-       long_response($self, 0, long_response_limit, sub {
-               my ($i) = @_;
-               my $nr = $self->{ng}->mm->id_batch($$i, sub {
-                       my ($ary) = @_;
-                       more($self, join("\r\n", @$ary));
-               });
-
-               # -1 to adjust for implicit increment in long_response
-               $$i = $nr ? $$i + $nr - 1 : long_response_limit;
+       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;
        });
 }
 
 sub parse_time ($$;$) {
        my ($date, $time, $gmt) = @_;
-       use Time::Local qw();
        my ($hh, $mm, $ss) = unpack('A2A2A2', $time);
        if (defined $gmt) {
                $gmt =~ /\A(?:UTC|GMT)\z/i or die "GM invalid: $gmt";
@@ -265,15 +246,15 @@ sub parse_time ($$;$) {
                ($YYYY, $MM, $DD) = unpack('A4A2A2', $date);
        } else { # legacy clients send YYMMDD
                ($YYYY, $MM, $DD) = unpack('A2A2A2', $date);
-               if ($YYYY > strftime('%y', @now)) {
-                       my $cur_year = $now[5] + 1900;
+               my $cur_year = $now[5] + 1900;
+               if ($YYYY > $cur_year) {
                        $YYYY += int($cur_year / 1000) * 1000 - 100;
                }
        }
        if ($gmt) {
-               Time::Local::timegm($ss, $mm, $hh, $DD, $MM - 1, $YYYY);
+               timegm($ss, $mm, $hh, $DD, $MM - 1, $YYYY);
        } else {
-               Time::Local::timelocal($ss, $mm, $hh, $DD, $MM - 1, $YYYY);
+               timelocal($ss, $mm, $hh, $DD, $MM - 1, $YYYY);
        }
 }
 
@@ -302,7 +283,6 @@ sub wildmat2re (;$) {
        return $_[0] = qr/.*/ if (!defined $_[0] || $_[0] eq '*');
        my %keep;
        my $salt = rand;
-       use Digest::SHA qw(sha1_hex);
        my $tmp = $_[0];
 
        $tmp =~ s#(?<!\\)\[(.+)(?<!\\)\]#
@@ -347,24 +327,22 @@ sub cmd_newnews ($$$$;$$) {
        };
        return '.' unless @srch;
 
-       $ts .= '..';
-       my $opts = { asc => 1, limit => 1000, offset => 0 };
-       long_response($self, 0, long_response_limit, sub {
-               my ($i) = @_;
+       my $prev = 0;
+       long_response($self, sub {
                my $srch = $srch[0];
-               my $res = $srch->query($ts, $opts);
-               my $msgs = $res->{msgs};
-               if (my $nr = scalar @$msgs) {
+               my $msgs = $srch->query_ts($ts, $prev);
+               if (scalar @$msgs) {
                        more($self, '<' .
                                join(">\r\n<", map { $_->mid } @$msgs ).
                                '>');
-                       $opts->{offset} += $nr;
+                       $prev = $msgs->[-1]->{num};
                } else {
                        shift @srch;
                        if (@srch) { # continue onto next newsgroup
-                               $opts->{offset} = 0;
+                               $prev = 0;
+                               return 1;
                        } else { # break out of the long response.
-                               $$i = long_response_limit;
+                               return;
                        }
                }
        });
@@ -437,7 +415,7 @@ sub set_nntp_headers {
        $hdr->header_set('Xref', xref($ng, $n));
        header_append($hdr, 'List-Post', "<mailto:$ng->{-primary_address}>");
        if (my $url = $ng->base_url) {
-               $mid = uri_escape_utf8($mid);
+               $mid = mid_escape($mid);
                header_append($hdr, 'Archived-At', "<$url$mid/>");
                header_append($hdr, 'List-Archive', "<$url>");
        }
@@ -479,18 +457,16 @@ find_mid:
                defined $mid or return $err;
        }
 found:
-       my $bytes;
-       my $s = eval { $ng->msg_by_mid($mid, \$bytes) } or return $err;
-       $s = Email::Simple->new($s);
-       my $lines;
+       my $smsg = $ng->search->{over_ro}->get_art($n) or return $err;
+       my $msg = $ng->msg_by_smsg($smsg) or return $err;
+       my $s = Email::Simple->new($msg);
        if ($set_headers) {
                set_nntp_headers($s->header_obj, $ng, $n, $mid);
-               $lines = $s->body =~ tr!\n!\n!;
 
                # must be last
                $s->body_set('') if ($set_headers == 2);
        }
-       [ $n, $mid, $s, $bytes, $lines, $ng ];
+       [ $n, $mid, $s, $smsg->bytes, $smsg->lines, $ng ];
 }
 
 sub simple_body_write ($$) {
@@ -588,8 +564,8 @@ sub get_range ($$) {
        [ $beg, $end ];
 }
 
-sub long_response ($$$$) {
-       my ($self, $beg, $end, $cb) = @_;
+sub long_response ($$) {
+       my ($self, $cb) = @_;
        die "BUG: nested long response" if $self->{long_res};
 
        my $fd = $self->{fd};
@@ -600,23 +576,14 @@ sub long_response ($$$$) {
        $self->watch_read(0);
        my $t0 = now();
        $self->{long_res} = sub {
-               # limit our own running time for fairness with other
-               # clients and to avoid buffering too much:
-               my $lim = 100;
-
-               my $err;
-               do {
-                       eval { $cb->(\$beg) };
-               } until (($err = $@) || $self->{closed} ||
-                        ++$beg > $end || !--$lim || $self->{write_buf_size});
-
-               if ($err || $self->{closed}) {
+               my $more = eval { $cb->() };
+               if ($@ || $self->{closed}) {
                        $self->{long_res} = undef;
 
-                       if ($err) {
+                       if ($@) {
                                err($self,
                                    "%s during long response[$fd] - %0.6f",
-                                   $err, now() - $t0);
+                                   $@, now() - $t0);
                        }
                        if ($self->{closed}) {
                                out($self, " deferred[$fd] aborted - %0.6f",
@@ -625,7 +592,7 @@ sub long_response ($$$$) {
                                update_idle_time($self);
                                $self->watch_read(1);
                        }
-               } elsif (!$lim || $self->{write_buf_size}) {
+               } elsif ($more) { # $self->{write_buf_size}:
                        # no recursion, schedule another call ASAP
                        # but only after all pending writes are done
                        update_idle_time($self);
@@ -657,10 +624,13 @@ sub hdr_message_id ($$$) { # optimize XHDR Message-ID [range] for slrnpull.
                my $mm = $self->{ng}->mm;
                my ($beg, $end) = @$r;
                more($self, $xhdr ? r221 : r225);
-               long_response($self, $beg, $end, sub {
-                       my ($i) = @_;
-                       my $mid = $mm->mid_for($$i);
-                       more($self, "$$i <$mid>") if defined $mid;
+               long_response($self, sub {
+                       my $r = $mm->msg_range(\$beg, $end);
+                       @$r or return;
+                       more($self, join("\r\n", map {
+                               "$_->[0] <$_->[1]>"
+                       } @$r));
+                       1;
                });
        }
 }
@@ -700,26 +670,33 @@ sub hdr_xref ($$$) { # optimize XHDR Xref [range] for rtin
                my $mm = $ng->mm;
                my ($beg, $end) = @$r;
                more($self, $xhdr ? r221 : r225);
-               long_response($self, $beg, $end, sub {
-                       my ($i) = @_;
-                       my $mid = $mm->mid_for($$i);
-                       more($self, "$$i ".xref($ng, $$i)) if defined $mid;
+               long_response($self, sub {
+                       my $r = $mm->msg_range(\$beg, $end);
+                       @$r or return;
+                       more($self, join("\r\n", map {
+                               # TODO: use $_->[1] (mid) to fill
+                               # Xref: from other inboxes
+                               my $num = $_->[0];
+                               "$num ".xref($ng, $num);
+                       } @$r));
+                       1;
                });
        }
 }
 
 sub search_header_for {
-       my ($srch, $mid, $field) = @_;
-       my $smsg = $srch->lookup_mail($mid) or return;
-       $smsg->$field;
+       my ($srch, $num, $field) = @_;
+       my $smsg = $srch->{over_ro}->get_art($num) or return;
+       return PublicInbox::SearchMsg::date($smsg) if $field eq 'date';
+       $smsg->{$field};
 }
 
 sub hdr_searchmsg ($$$$) {
        my ($self, $xhdr, $field, $range) = @_;
        if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
                my ($ng, $n) = mid_lookup($self, $1);
-               return r430 unless $n;
-               my $v = search_header_for($ng->search, $range, $field);
+               return r430 unless defined $n;
+               my $v = search_header_for($ng->search, $n, $field);
                hdr_mid_response($self, $xhdr, $ng, $n, $range, $v);
        } else { # numeric range
                $range = $self->{article} unless defined $range;
@@ -729,21 +706,17 @@ sub hdr_searchmsg ($$$$) {
                return $r unless ref $r;
                my ($beg, $end) = @$r;
                more($self, $xhdr ? r221 : r225);
-               my $off = 0;
-               long_response($self, $beg, $end, sub {
-                       my ($i) = @_;
-                       my $res = $srch->query_xover($beg, $end, $off);
-                       my $msgs = $res->{msgs};
+               my $cur = $beg;
+               long_response($self, sub {
+                       my $msgs = $srch->query_xover($cur, $end);
                        my $nr = scalar @$msgs or return;
-                       $off += $nr;
                        my $tmp = '';
                        foreach my $s (@$msgs) {
                                $tmp .= $s->num . ' ' . $s->$field . "\r\n";
                        }
                        utf8::encode($tmp);
                        do_more($self, $tmp);
-                       # -1 to adjust for implicit increment in long_response
-                       $$i = $nr ? $$i + $nr - 1 : long_response_limit;
+                       $cur = $msgs->[-1]->{num} + 1;
                });
        }
 }
@@ -817,11 +790,11 @@ sub cmd_xrover ($;$) {
        my $mm = $ng->mm;
        my $srch = $ng->search;
        more($self, '224 Overview information follows');
-       long_response($self, $beg, $end, sub {
-               my ($i) = @_;
-               my $mid = $mm->mid_for($$i) or return;
-               my $h = search_header_for($srch, $mid, 'references');
-               more($self, "$$i $h");
+
+       long_response($self, sub {
+               my $h = search_header_for($srch, $beg, 'references');
+               more($self, "$beg $h") if defined($h);
+               $beg++ < $end;
        });
 }
 
@@ -833,10 +806,10 @@ sub over_line ($$) {
                $smsg->{subject},
                $smsg->{from},
                PublicInbox::SearchMsg::date($smsg),
-               '<'.PublicInbox::SearchMsg::mid($smsg).'>',
+               "<$smsg->{mid}>",
                $smsg->{references},
-               PublicInbox::SearchMsg::bytes($smsg),
-               PublicInbox::SearchMsg::lines($smsg));
+               $smsg->{bytes},
+               $smsg->{lines});
        utf8::encode($s);
        $s
 }
@@ -845,8 +818,8 @@ sub cmd_over ($;$) {
        my ($self, $range) = @_;
        if ($range && $range =~ /\A<(.+)>\z/) {
                my ($ng, $n) = mid_lookup($self, $1);
-               my $smsg = $ng->search->lookup_mail($range) or
-                       return '430 No article with that message-id';
+               defined $n or return r430;
+               my $smsg = $ng->search->{over_ro}->get_art($n) or return r430;
                more($self, '224 Overview information follows (multi-line)');
 
                # Only set article number column if it's the current group
@@ -867,21 +840,16 @@ sub cmd_xover ($;$) {
        my ($beg, $end) = @$r;
        more($self, "224 Overview information follows for $beg to $end");
        my $srch = $self->{ng}->search;
-       my $off = 0;
-       long_response($self, $beg, $end, sub {
-               my ($i) = @_;
-               my $res = $srch->query_xover($beg, $end, $off);
-               my $msgs = $res->{msgs};
+       my $cur = $beg;
+       long_response($self, sub {
+               my $msgs = $srch->query_xover($cur, $end);
                my $nr = scalar @$msgs or return;
-               $off += $nr;
 
                # OVERVIEW.FMT
                more($self, join("\r\n", map {
-                       over_line(PublicInbox::SearchMsg::num($_), $_);
+                       over_line($_->{num}, $_);
                        } @$msgs));
-
-               # -1 to adjust for implicit increment in long_response
-               $$i = $nr ? $$i + $nr - 1 : long_response_limit;
+               $cur = $msgs->[-1]->{num} + 1;
        });
 }
 
@@ -911,7 +879,7 @@ sub more ($$) {
 sub do_write ($$) {
        my ($self, $data) = @_;
        my $done = $self->write($data);
-       die if $self->{closed};
+       return if $self->{closed};
 
        # Do not watch for readability if we have data in the queue,
        # instead re-enable watching for readability when we can