]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/NNTP.pm
nntp: small speed up for multi-line responses
[public-inbox.git] / lib / PublicInbox / NNTP.pm
index b641bd23e5304f964586544dec4dd340e2f67eff..05d2d13bbbea83880b036565b2a356802ff2322e 100644 (file)
@@ -17,6 +17,8 @@ use PublicInbox::DS qw(now);
 use Digest::SHA qw(sha1_hex);
 use Time::Local qw(timegm timelocal);
 use PublicInbox::GitAsyncCat;
+use PublicInbox::Address;
+
 use constant {
        LINE_MAX => 512, # RFC 977 section 2.3
        r501 => '501 command syntax error',
@@ -31,9 +33,9 @@ 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";
+               "Xref:full\r\n.";
 my $LIST_HEADERS = join("\r\n", @OVERVIEW,
-                       qw(:bytes :lines Xref To Cc)) . "\r\n";
+                       qw(:bytes :lines Xref To Cc)) . "\r\n.";
 my $CAPABILITIES = <<"";
 101 Capability list:\r
 VERSION 2\r
@@ -92,8 +94,7 @@ sub process_line ($$) {
                err($self, 'error from: %s (%s)', $l, $err);
                $res = '503 program fault - command not performed';
        }
-       return 0 unless defined $res;
-       res($self, $res);
+       defined($res) ? res($self, $res) : 0;
 }
 
 # The keyword argument is not used (rfc3977 5.2.2)
@@ -109,9 +110,7 @@ sub cmd_capabilities ($;$) {
 
 sub cmd_mode ($$) {
        my ($self, $arg) = @_;
-       $arg = uc $arg;
-       return r501 unless $arg eq 'READER';
-       '201 Posting prohibited';
+       uc($arg) eq 'READER' ? '201 Posting prohibited' : r501;
 }
 
 sub cmd_slave ($) { '202 slave status noted' }
@@ -120,46 +119,66 @@ sub cmd_xgtitle ($;$) {
        my ($self, $wildmat) = @_;
        more($self, '282 list of groups and descriptions follows');
        list_newsgroups($self, $wildmat);
-       '.'
 }
 
-sub list_overview_fmt ($) {
-       my ($self) = @_;
-       $self->msg_more($OVERVIEW_FMT);
-}
+sub list_overview_fmt ($) { $OVERVIEW_FMT }
 
-sub list_headers ($;$) {
-       my ($self) = @_;
-       $self->msg_more($LIST_HEADERS);
+sub list_headers ($;$) { $LIST_HEADERS }
+
+sub list_active_i { # "LIST ACTIVE" and also just "LIST" (no args)
+       my ($self, $groupnames) = @_;
+       my @window = splice(@$groupnames, 0, 100) or return 0;
+       my $ibx;
+       my $groups = $self->{nntpd}->{pi_config}->{-by_newsgroup};
+       for my $ngname (@window) {
+               $ibx = $groups->{$ngname} and group_line($self, $ibx);
+       }
+       scalar(@$groupnames); # continue if there's more
 }
 
-sub list_active ($;$) {
+sub list_active ($;$) { # called by cmd_list
        my ($self, $wildmat) = @_;
        wildmat2re($wildmat);
-       foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
-               $ng->{newsgroup} =~ $wildmat or next;
-               group_line($self, $ng);
+       long_response($self, \&list_active_i, [
+               grep(/$wildmat/, @{$self->{nntpd}->{groupnames}}) ]);
+}
+
+sub list_active_times_i {
+       my ($self, $groupnames) = @_;
+       my @window = splice(@$groupnames, 0, 100) or return 0;
+       my $groups = $self->{nntpd}->{pi_config}->{-by_newsgroup};
+       for my $ngname (@window) {
+               my $ibx = $groups->{$ngname} or next;
+               my $c = eval { $ibx->uidvalidity } // time;
+               more($self, "$ngname $c <$ibx->{-primary_address}>");
        }
+       scalar(@$groupnames); # continue if there's more
 }
 
-sub list_active_times ($;$) {
+sub list_active_times ($;$) { # called by cmd_list
        my ($self, $wildmat) = @_;
        wildmat2re($wildmat);
-       foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
-               $ng->{newsgroup} =~ $wildmat or next;
-               my $c = eval { $ng->uidvalidity } // time;
-               more($self, "$ng->{newsgroup} $c $ng->{-primary_address}");
+       long_response($self, \&list_active_times_i, [
+               grep(/$wildmat/, @{$self->{nntpd}->{groupnames}}) ]);
+}
+
+sub list_newsgroups_i {
+       my ($self, $groupnames) = @_;
+       my @window = splice(@$groupnames, 0, 100) or return 0;
+       my $groups = $self->{nntpd}->{pi_config}->{-by_newsgroup};
+       my $ibx;
+       for my $ngname (@window) {
+               $ibx = $groups->{$ngname} and
+                       more($self, "$ngname ".$ibx->description);
        }
+       scalar(@$groupnames); # continue if there's more
 }
 
-sub list_newsgroups ($;$) {
+sub list_newsgroups ($;$) { # called by cmd_list
        my ($self, $wildmat) = @_;
        wildmat2re($wildmat);
-       foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
-               $ng->{newsgroup} =~ $wildmat or next;
-               my $d = $ng->description;
-               more($self, "$ng->{newsgroup} $d");
-       }
+       long_response($self, \&list_newsgroups_i, [
+               grep(/$wildmat/, @{$self->{nntpd}->{groupnames}}) ]);
 }
 
 # LIST SUBSCRIPTIONS, DISTRIB.PATS are not supported
@@ -168,6 +187,7 @@ sub cmd_list ($;$$) {
        if (scalar @args) {
                my $arg = shift @args;
                $arg =~ tr/A-Z./a-z_/;
+               my $ret = $arg eq 'active';
                $arg = "list_$arg";
                $arg = $self->can($arg);
                return r501 unless $arg && args_ok($arg, scalar @args);
@@ -175,18 +195,16 @@ sub cmd_list ($;$$) {
                $arg->($self, @args);
        } else {
                more($self, '215 list of newsgroups follows');
-               foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
-                       group_line($self, $ng);
-               }
+               long_response($self, \&list_active_i, [ # copy array
+                       @{$self->{nntpd}->{groupnames}} ]);
        }
-       '.'
 }
 
 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));
+       $self->msg_more(join('', map { "$_->[0]\r\n" } @$r));
        1;
 }
 
@@ -247,6 +265,19 @@ sub group_line ($$) {
        more($self, "$ng->{newsgroup} $max $min n");
 }
 
+sub newgroups_i {
+       my ($self, $ts, $i, $groupnames) = @_;
+       my $end = $$i + 100;
+       my $groups = $self->{nntpd}->{pi_config}->{-by_newsgroup};
+       while ($$i < $end) {
+               my $ngname = $groupnames->[$$i++] // return;
+               my $ibx = $groups->{$ngname} or next; # expired on reload
+               next unless (eval { $ibx->uidvalidity } // 0) > $ts;
+               group_line($self, $ibx);
+       }
+       1;
+}
+
 sub cmd_newgroups ($$$;$$) {
        my ($self, $date, $time, $gmt, $dists) = @_;
        my $ts = eval { parse_time($date, $time, $gmt) };
@@ -254,12 +285,8 @@ sub cmd_newgroups ($$$;$$) {
 
        # TODO dists
        more($self, '231 list of new newsgroups follows');
-       foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
-               my $c = eval { $ng->uidvalidity } // 0;
-               next unless $c > $ts;
-               group_line($self, $ng);
-       }
-       '.'
+       long_response($self, \&newgroups_i, $ts, \(my $i = 0),
+                               $self->{nntpd}->{groupnames});
 }
 
 sub wildmat2re (;$) {
@@ -294,23 +321,27 @@ sub ngpat2re (;$) {
 }
 
 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;
+       my ($self, $names, $ts, $prev) = @_;
+       my $ngname = $names->[0];
+       if (my $ibx = $self->{nntpd}->{pi_config}->{-by_newsgroup}->{$ngname}) {
+               if (my $over = $ibx->over) {
+                       my $msgs = $over->query_ts($ts, $$prev);
+                       if (scalar @$msgs) {
+                               $self->msg_more(join('', map {
+                                                       "<$_->{mid}>\r\n";
+                                               } @$msgs));
+                               $$prev = $msgs->[-1]->{num};
+                               return 1; # continue on current group
+                       }
                }
        }
+       shift @$names;
+       if (@$names) { # continue onto next newsgroup
+               $$prev = 0;
+               1;
+       } else { # all done, break out of the long_response
+               undef;
+       }
 }
 
 sub cmd_newnews ($$$$;$$) {
@@ -321,28 +352,22 @@ sub cmd_newnews ($$$$;$$) {
        my ($keep, $skip) = split('!', $newsgroups, 2);
        ngpat2re($keep);
        ngpat2re($skip);
-       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 @overs, $over;
-       };
-       return '.' unless @overs;
-
+       my @names = grep(!/$skip/, grep(/$keep/,
+                               @{$self->{nntpd}->{groupnames}}));
+       return '.' unless scalar(@names);
        my $prev = 0;
-       long_response($self, \&newnews_i, \@overs, $ts, \$prev);
+       long_response($self, \&newnews_i, \@names, $ts, \$prev);
 }
 
 sub cmd_group ($$) {
        my ($self, $group) = @_;
-       my $no_such = '411 no such news group';
        my $nntpd = $self->{nntpd};
-       my $ng = $nntpd->{groups}->{$group} or return $no_such;
+       my $ibx = $nntpd->{pi_config}->{-by_newsgroup}->{$group} or
+               return '411 no such news group';
        $nntpd->idler_start;
 
-       $self->{ng} = $ng;
-       my ($min, $max) = $ng->mm->minmax;
+       $self->{ng} = $ibx;
+       my ($min, $max) = $ibx->mm->minmax;
        $self->{article} = $min;
        my $est_size = $max - $min;
        "211 $est_size $min $max $group";
@@ -393,19 +418,41 @@ sub header_append ($$$) {
        $hdr->header_set($k, @v, $v);
 }
 
-sub xref ($$$$) {
-       my ($self, $ng, $n, $mid) = @_;
-       my $ret = $self->{nntpd}->{servername} . " $ng->{newsgroup}:$n";
+sub xref_by_tc ($$$) {
+       my ($xref, $pi_cfg, $smsg) = @_;
+       my $by_addr = $pi_cfg->{-by_addr};
+       my $mid = $smsg->{mid};
+       for my $f (qw(to cc)) {
+               my @ibxs = map {
+                       $by_addr->{lc($_)} // ()
+               } (PublicInbox::Address::emails($smsg->{$f} // ''));
+               for my $ibx (@ibxs) {
+                       my $ngname = $ibx->{newsgroup} // next;
+                       next if defined $xref->{$ngname};
+                       $xref->{$ngname} = eval { $ibx->mm->num_for($mid) };
+               }
+       }
+}
 
-       # num_for is pretty cheap and sometimes we'll lookup the existence
-       # of an article without getting even the OVER info.  In other words,
-       # I'm not sure if its worth optimizing by scanning To:/Cc: and
-       # PublicInbox::ExtMsg on the PSGI end is just as expensive
-       foreach my $other (@{$self->{nntpd}->{grouplist}}) {
-               next if $ng eq $other;
-               my $num = eval { $other->mm->num_for($mid) } or next;
-               $ret .= " $other->{newsgroup}:$num";
+sub xref ($$$) {
+       my ($self, $cur_ibx, $smsg) = @_;
+       my $nntpd = $self->{nntpd};
+       my $cur_ng = $cur_ibx->{newsgroup};
+       my $xref;
+       if (my $ALL = $nntpd->{pi_config}->ALL) {
+               $xref = $ALL->nntp_xref_for($cur_ibx, $smsg);
+               xref_by_tc($xref, $nntpd->{pi_config}, $smsg);
+       } else { # slow path
+               $xref = { $cur_ng => $smsg->{num} };
+               my $mid = $smsg->{mid};
+               for my $ibx (values %{$nntpd->{pi_config}->{-by_newsgroup}}) {
+                       next if defined($xref->{$ibx->{newsgroup}});
+                       my $num = eval { $ibx->mm->num_for($mid) } // next;
+                       $xref->{$ibx->{newsgroup}} = $num;
+               }
        }
+       my $ret = "$nntpd->{servername} $cur_ng:".delete($xref->{$cur_ng});
+       $ret .= " $_:$xref->{$_}" for (sort keys %$xref);
        $ret;
 }
 
@@ -428,7 +475,7 @@ sub set_nntp_headers ($$) {
 
        # clobber some existing headers
        my $ibx = $smsg->{-ibx};
-       my $xref = xref($smsg->{nntp}, $ibx, $smsg->{num}, $mid);
+       my $xref = xref($smsg->{nntp}, $ibx, $smsg);
        $hdr->header_set('Xref', $xref);
 
        # RFC 5536 3.1.4
@@ -451,42 +498,30 @@ sub set_nntp_headers ($$) {
 
 sub art_lookup ($$$) {
        my ($self, $art, $code) = @_;
-       my $ng = $self->{ng};
-       my ($n, $mid);
+       my ($ibx, $n);
        my $err;
        if (defined $art) {
                if ($art =~ /\A[0-9]+\z/) {
                        $err = '423 no such article number in this group';
                        $n = int($art);
-                       goto find_mid;
+                       goto find_ibx;
                } elsif ($art =~ $ONE_MSGID) {
-                       $mid = $1;
-                       $err = r430;
-                       $n = $ng->mm->num_for($mid) if $ng;
-                       goto found if defined $n;
-                       foreach my $g (values %{$self->{nntpd}->{groups}}) {
-                               $n = $g->mm->num_for($mid);
-                               if (defined $n) {
-                                       $ng = $g;
-                                       goto found;
-                               }
-                       }
-                       return $err;
+                       ($ibx, $n) = mid_lookup($self, $1);
+                       goto found if $ibx;
+                       return r430;
                } else {
                        return r501;
                }
        } else {
                $err = '420 no current article has been selected';
-               $n = $self->{article};
-               defined $n or return $err;
-find_mid:
-               $ng or return '412 no newsgroup has been selected';
-               $mid = $ng->mm->mid_for($n);
-               defined $mid or return $err;
+               $n = $self->{article} // return $err;
+find_ibx:
+               $ibx = $self->{ng} or
+                               return '412 no newsgroup has been selected';
        }
 found:
-       my $smsg = $ng->over->get_art($n) or return $err;
-       $smsg->{-ibx} = $ng;
+       my $smsg = $ibx->over->get_art($n) or return $err;
+       $smsg->{-ibx} = $ibx;
        if ($code == 223) { # STAT
                set_art($self, $n);
                "223 $n <$smsg->{mid}> article retrieved - " .
@@ -496,7 +531,7 @@ found:
                $smsg->{nntp_code} = $code;
                set_art($self, $art);
                # this dereferences to `undef'
-               ${git_async_cat($ng->git, $smsg->{blob}, \&blob_cb, $smsg)};
+               ${git_async_cat($ibx->git, $smsg->{blob}, \&blob_cb, $smsg)};
        }
 }
 
@@ -671,7 +706,7 @@ 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));
+       $self->msg_more(join('', map { "$_->[0] <$_->[1]>\r\n" } @$r));
        1;
 }
 
@@ -698,10 +733,36 @@ sub mid_lookup ($$) {
                my $n = $self_ng->mm->num_for($mid);
                return ($self_ng, $n) if defined $n;
        }
-       foreach my $ng (values %{$self->{nntpd}->{groups}}) {
-               next if defined $self_ng && $ng eq $self_ng;
-               my $n = $ng->mm->num_for($mid);
-               return ($ng, $n) if defined $n;
+       my $pi_cfg = $self->{nntpd}->{pi_config};
+       if (my $ALL = $pi_cfg->ALL) {
+               my ($id, $prev);
+               while (my $smsg = $ALL->over->next_by_mid($mid, \$id, \$prev)) {
+                       my $xr3 = $ALL->over->get_xref3($smsg->{num});
+                       if (my @x = grep(/:$smsg->{blob}\z/, @$xr3)) {
+                               my ($ngname, $xnum) = split(/:/, $x[0]);
+                               my $ibx = $pi_cfg->{-by_newsgroup}->{$ngname};
+                               return ($ibx, $xnum) if $ibx;
+                               # fall through to trying all xref3s
+                       } else {
+                               warn <<EOF;
+W: xref3 missing for <$mid> ($smsg->{blob}) in $ALL->{topdir}, -extindex bug?
+EOF
+                       }
+                       # try all xref3s
+                       for my $x (@$xr3) {
+                               my ($ngname, $xnum) = split(/:/, $x);
+                               my $ibx = $pi_cfg->{-by_newsgroup}->{$ngname};
+                               return ($ibx, $xnum) if $ibx;
+                               warn "W: `$ngname' does not exist for #$xnum\n";
+                       }
+               }
+               # no warning here, $mid is just invalid
+       } else { # slow path for non-ALL users
+               for my $ibx (values %{$pi_cfg->{-by_newsgroup}}) {
+                       next if defined $self_ng && $ibx eq $self_ng;
+                       my $n = $ibx->mm->num_for($mid);
+                       return ($ibx, $n) if defined $n;
+               }
        }
        (undef, undef);
 }
@@ -709,12 +770,12 @@ sub mid_lookup ($$) {
 sub xref_range_i {
        my ($self, $beg, $end) = @_;
        my $ng = $self->{ng};
-       my $r = $ng->mm->msg_range($beg, $end);
-       @$r or return;
-       more($self, join("\r\n", map {
-               my $num = $_->[0];
-               "$num ".xref($self, $ng, $num, $_->[1]);
-       } @$r));
+       my $msgs = $ng->over->query_xover($$beg, $end);
+       scalar(@$msgs) or return;
+       $$beg = $msgs->[-1]->{num} + 1;
+       $self->msg_more(join('', map {
+               "$_->{num} ".xref($self, $ng, $_) . "\r\n";
+       } @$msgs));
        1;
 }
 
@@ -725,8 +786,9 @@ sub hdr_xref ($$$) { # optimize XHDR Xref [range] for rtin
                my $mid = $1;
                my ($ng, $n) = mid_lookup($self, $mid);
                return r430 unless $n;
+               my $smsg = $ng->over->get_art($n) or return;
                hdr_mid_response($self, $xhdr, $ng, $n, $range,
-                               xref($self, $ng, $n, $mid));
+                               xref($self, $ng, $smsg));
        } else { # numeric range
                $range = $self->{article} unless defined $range;
                my $r = get_range($self, $range);
@@ -857,11 +919,11 @@ sub cmd_xrover ($;$) {
        long_response($self, \&xrover_i, @$r);
 }
 
-sub over_line ($$$$) {
-       my ($self, $ng, $num, $smsg) = @_;
+sub over_line ($$$) {
+       my ($self, $ng, $smsg) = @_;
        # n.b. field access and procedural calls can be
        # 10%-15% faster than OO method calls:
-       my $s = join("\t", $num,
+       my $s = join("\t", $smsg->{num},
                $smsg->{subject},
                $smsg->{from},
                PublicInbox::Smsg::date($smsg),
@@ -869,9 +931,9 @@ sub over_line ($$$$) {
                $smsg->{references},
                $smsg->{bytes},
                $smsg->{lines},
-               "Xref: " . xref($self, $ng, $num, $smsg->{mid}));
+               "Xref: " . xref($self, $ng, $smsg));
        utf8::encode($s);
-       $s
+       $s .= "\r\n";
 }
 
 sub cmd_over ($;$) {
@@ -883,9 +945,14 @@ sub cmd_over ($;$) {
                more($self, '224 Overview information follows (multi-line)');
 
                # Only set article number column if it's the current group
+               # (RFC 3977 8.3.2)
                my $self_ng = $self->{ng};
-               $n = 0 if (!$self_ng || $self_ng ne $ng);
-               more($self, over_line($self, $ng, $n, $smsg));
+               if (!$self_ng || $self_ng ne $ng) {
+                       # set {-orig_num} for nntp_xref_for
+                       $smsg->{-orig_num} = $smsg->{num};
+                       $smsg->{num} = 0;
+               }
+               $self->msg_more(over_line($self, $ng, $smsg));
                '.';
        } else {
                cmd_xover($self, $range);
@@ -899,8 +966,8 @@ sub xover_i {
        my $nr = scalar @$msgs or return;
 
        # OVERVIEW.FMT
-       more($self, join("\r\n", map {
-               over_line($self, $ng, $_->{num}, $_);
+       $self->msg_more(join('', map {
+               over_line($self, $ng, $_);
                } @$msgs));
        $$beg = $msgs->[-1]->{num} + 1;
 }
@@ -947,12 +1014,28 @@ sub cmd_xpath ($$) {
        return r501 unless $mid =~ $ONE_MSGID;
        $mid = $1;
        my @paths;
-       foreach my $ng (values %{$self->{nntpd}->{groups}}) {
-               my $n = $ng->mm->num_for($mid);
-               push @paths, "$ng->{newsgroup}/$n" if defined $n;
+       my $pi_cfg = $self->{nntpd}->{pi_config};
+       my $groups = $pi_cfg->{-by_newsgroup};
+       if (my $ALL = $pi_cfg->ALL) {
+               my ($id, $prev, %seen);
+               while (my $smsg = $ALL->over->next_by_mid($mid, \$id, \$prev)) {
+                       my $xr3 = $ALL->over->get_xref3($smsg->{num});
+                       for my $x (@$xr3) {
+                               my ($ngname, $n) = split(/:/, $x);
+                               $x = "$ngname/$n";
+                               if ($groups->{$ngname} && !$seen{$x}++) {
+                                       push(@paths, $x);
+                               }
+                       }
+               }
+       } else { # slow path, no point in using long_response
+               for my $ibx (values %$groups) {
+                       my $n = $ibx->mm->num_for($mid) // next;
+                       push @paths, "$ibx->{newsgroup}/$n";
+               }
        }
        return '430 no such article on server' unless @paths;
-       '223 '.join(' ', @paths);
+       '223 '.join(' ', sort(@paths));
 }
 
 sub res ($$) { do_write($_[0], $_[1] . "\r\n") }