Put the NNTP server name into Xref lines

[public-inbox.git] / lib / PublicInbox / NNTP.pm

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index e51793505cf515851f7031dc65c982918076f89c..cbd4ecf155a22ae2aae5ef45e36cc3a80e25fef9 100644 (file)
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -94,7 +94,7 @@ sub new ($$$) {
        my $self = fields::new($class);
        $self->SUPER::new($sock);
        $self->{nntpd} = $nntpd;
-       res($self, '201 server ready - post via email');
+       res($self, '201 ' . $nntpd->{servername} . ' ready - post via email');
        $self->{rbuf} = '';
        $self->watch_read(1);
        update_idle_time($self);
@@ -115,6 +115,7 @@ sub args_ok ($$) {
 sub process_line ($$) {
        my ($self, $l) = @_;
        my ($req, @args) = split(/\s+/, $l);
+       return unless defined($req);
        $req = lc($req);
        $req = eval {
                no strict 'refs';
@@ -407,12 +408,30 @@ sub header_append ($$$) {
        $hdr->header_set($k, @v, $v);
 }
 
-sub set_nntp_headers {
-       my ($hdr, $ng, $n, $mid) = @_;
+sub xref ($$$$) {
+       my ($self, $ng, $n, $mid) = @_;
+       my $ret = $self->{nntpd}->{servername} . " $ng->{newsgroup}:$n";
+
+       # 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";
+       }
+       $ret;
+}
+
+sub set_nntp_headers ($$$$$) {
+       my ($self, $hdr, $ng, $n, $mid) = @_;
 
        # clobber some
-       $hdr->header_set('Newsgroups', $ng->{newsgroup});
-       $hdr->header_set('Xref', xref($ng, $n));
+       my $xref = xref($self, $ng, $n, $mid);
+       $hdr->header_set('Xref', $xref);
+       $xref =~ s/:\d+//g;
+       $hdr->header_set('Newsgroups', (split(/ /, $xref, 2))[1]);
        header_append($hdr, 'List-Post', "<mailto:$ng->{-primary_address}>");
        if (my $url = $ng->base_url) {
                $mid = mid_escape($mid);
@@ -461,7 +480,7 @@ found:
        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);
+               set_nntp_headers($self, $s->header_obj, $ng, $n, $mid);
 
                # must be last
                $s->body_set('') if ($set_headers == 2);
@@ -635,11 +654,6 @@ sub hdr_message_id ($$$) { # optimize XHDR Message-ID [range] for slrnpull.
        }
 }
 
-sub xref ($$) {
-       my ($ng, $n) = @_;
-       "$ng->{domain} $ng->{newsgroup}:$n"
-}
-
 sub mid_lookup ($$) {
        my ($self, $mid) = @_;
        my $self_ng = $self->{ng};
@@ -659,9 +673,11 @@ sub hdr_xref ($$$) { # optimize XHDR Xref [range] for rtin
        my ($self, $xhdr, $range) = @_;
 
        if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
-               my ($ng, $n) = mid_lookup($self, $1);
+               my $mid = $1;
+               my ($ng, $n) = mid_lookup($self, $mid);
                return r430 unless $n;
-               hdr_mid_response($self, $xhdr, $ng, $n, $range, xref($ng, $n));
+               hdr_mid_response($self, $xhdr, $ng, $n, $range,
+                               xref($self, $ng, $n, $mid));
        } else { # numeric range
                $range = $self->{article} unless defined $range;
                my $r = get_range($self, $range);
@@ -674,10 +690,8 @@ sub hdr_xref ($$$) { # optimize XHDR Xref [range] for rtin
                        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);
+                               "$num ".xref($self, $ng, $num, $_->[1]);
                        } @$r));
                        1;
                });
@@ -712,7 +726,7 @@ sub hdr_searchmsg ($$$$) {
                        my $nr = scalar @$msgs or return;
                        my $tmp = '';
                        foreach my $s (@$msgs) {
-                               $tmp .= $s->num . ' ' . $s->$field . "\r\n";
+                               $tmp .= $s->{num} . ' ' . $s->$field . "\r\n";
                        }
                        utf8::encode($tmp);
                        do_more($self, $tmp);
@@ -930,11 +944,13 @@ sub event_write {
 sub event_read {
        my ($self) = @_;
        use constant LINE_MAX => 512; # RFC 977 section 2.3
-       my $r = 1;
 
-       my $buf = $self->read(LINE_MAX) or return $self->close;
-       $self->{rbuf} .= $$buf;
-       while ($r > 0 && $self->{rbuf} =~ s/\A\s*([^\r\n]+)\r?\n//) {
+       if (index($self->{rbuf}, "\n") < 0) {
+               my $buf = $self->read(LINE_MAX) or return $self->close;
+               $self->{rbuf} .= $$buf;
+       }
+       my $r = 1;
+       while ($r > 0 && $self->{rbuf} =~ s/\A\s*([^\r\n]*)\r?\n//) {
                my $line = $1;
                return $self->close if $line =~ /[[:cntrl:]]/s;
                my $t0 = now();
@@ -954,7 +970,7 @@ sub event_read {
 sub watch_read {
        my ($self, $bool) = @_;
        my $rv = $self->SUPER::watch_read($bool);
-       if ($bool && $self->{rbuf} ne '') {
+       if ($bool && index($self->{rbuf}, "\n") >= 0) {
                # Force another read if there is a pipelined request.
                # We don't know if the socket has anything for us to read,
                # and we must double-check again by the time the timer fires