nntp: append Archived-At and List-Archive headers

For readers using NNTP, we should do our best to advertise the
clonable HTTP/HTTPS URLs and the message permalink URL for
ease-of-referencing messages, since we don't want the NNTP server
and it's sequential article numbers to be relied on.

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index a4cf25e29ae574f7d5b4ddf0ef49cd16dface2c7..3e0faaf96dd8f3f45e2f3e44696bec53aec2c771 100644 (file)
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -15,6 +15,7 @@ use Email::MIME;
 use Data::Dumper qw(Dumper);
 use POSIX qw(strftime);
 use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);
+use URI::Escape qw(uri_escape_utf8);
 use constant {
        r501 => '501 command syntax error',
        r221 => '221 Header follows',
@@ -426,6 +427,29 @@ sub cmd_quit ($) {
        undef;
 }
 
+sub header_append ($$$) {
+       my ($hdr, $k, $v) = @_;
+       my @v = $hdr->header($k);
+       foreach (@v) {
+               return if $v eq $_;
+       }
+       $hdr->header_set($k, @v, $v);
+}
+
+sub set_nntp_headers {
+       my ($hdr, $ng, $n, $mid) = @_;
+
+       # clobber some
+       $hdr->header_set('Newsgroups', $ng->{name});
+       $hdr->header_set('Xref', xref($ng, $n));
+       header_append($hdr, 'List-Post', "<mailto:$ng->{address}>");
+       if (my $url = $ng->{url}) {
+               $mid = uri_escape_utf8($mid);
+               header_append($hdr, 'Archived-At', "<$url$mid/>");
+               header_append($hdr, 'List-Archive', "<$url>");
+       }
+}
+
 sub art_lookup ($$$) {
        my ($self, $art, $set_headers) = @_;
        my $ng = $self->{ng};
@@ -468,8 +492,7 @@ found:
        return $err unless $s;
        my $lines;
        if ($set_headers) {
-               $s->header_set('Newsgroups', $ng->{name});
-               $s->header_set('Xref', xref($ng, $n));
+               set_nntp_headers($s->header_obj, $ng, $n, $mid);
                $lines = $s->body =~ tr!\n!\n!;
 
                # must be last

diff --git a/lib/PublicInbox/NNTPD.pm b/lib/PublicInbox/NNTPD.pm
index 85109ea7ed57b722d8822c51339635c4b8ca6649..2c84fb3004f1271702c04a4cfda484b50d8d3386 100644 (file)
--- a/lib/PublicInbox/NNTPD.pm
+++ b/lib/PublicInbox/NNTPD.pm
@@ -30,11 +30,12 @@ sub refresh_groups () {
                my $git_dir = $pi_config->{$k};
                my $addr = $pi_config->{"publicinbox.$g.address"};
                my $ngname = $pi_config->{"publicinbox.$g.newsgroup"};
+               my $url = $pi_config->{"publicinbox.$g.url"};
                if (defined $ngname) {
                        next if ($ngname eq ''); # disabled
                        $g = $ngname;
                }
-               my $ng = PublicInbox::NewsGroup->new($g, $git_dir, $addr);
+               my $ng = PublicInbox::NewsGroup->new($g, $git_dir, $addr, $url);
                my $old_ng = $self->{groups}->{$g};
 
                # Reuse the old one if possible since it can hold

diff --git a/lib/PublicInbox/NewsGroup.pm b/lib/PublicInbox/NewsGroup.pm
index adac919fe0b2e15143528d113b2d122f25266a5a..98a3595ad918931b7b3c8b4c319d02b5a479e79c 100644 (file)
--- a/lib/PublicInbox/NewsGroup.pm
+++ b/lib/PublicInbox/NewsGroup.pm
@@ -13,12 +13,21 @@ require PublicInbox::Search;
 require PublicInbox::Git;
 
 sub new {
-       my ($class, $name, $git_dir, $address) = @_;
+       my ($class, $name, $git_dir, $address, $url) = @_;
+
+       # first email address is preferred
        $address = $address->[0] if ref($address);
+       if ($url) {
+               # assume protocol-relative URLs which start with '//' means
+               # the server supports both HTTP and HTTPS, favor HTTPS.
+               $url = "https:$url" if $url =~ m!\A//!;
+               $url .= '/' if $url !~ m!/\z!;
+       }
        my $self = bless {
                name => $name,
                git_dir => $git_dir,
                address => $address,
+               url => $url,
        }, $class;
        $self->{domain} = ($address =~ /\@(\S+)\z/) ? $1 : 'localhost';
        $self;

diff --git a/t/nntp.t b/t/nntp.t
index 388620e550c26db752f5b75f15d02fe05e257c28..5513c7bcd58a5be43e02876f374157d2707ad0b4 100644 (file)
--- a/t/nntp.t
+++ b/t/nntp.t
@@ -11,6 +11,7 @@ foreach my $mod (qw(DBD::SQLite Search::Xapian Danga::Socket)) {
 }
 
 use_ok 'PublicInbox::NNTP';
+use_ok 'PublicInbox::NewsGroup';
 
 {
        sub quote_str {
@@ -95,4 +96,37 @@ use_ok 'PublicInbox::NNTP';
        }
 }
 
+{ # test setting NNTP headers in HEAD and ARTICLE requests
+       require Email::MIME;
+       my $u = 'https://example.com/a/';
+       my $ng = PublicInbox::NewsGroup->new('test', 'test.git',
+                               'a@example.com', '//example.com/a');
+       is($ng->{url}, $u, 'URL expanded');
+       my $mid = 'a@b';
+       my $mime = Email::MIME->new("Message-ID: <$mid>\r\n\r\n");
+       PublicInbox::NNTP::set_nntp_headers($mime->header_obj, $ng, 1, $mid);
+       is_deeply([ $mime->header('Message-ID') ], [ "<$mid>" ],
+               'Message-ID unchanged');
+       is_deeply([ $mime->header('Archived-At') ], [ "<${u}a%40b/>" ],
+               'Archived-At: set');
+       is_deeply([ $mime->header('List-Archive') ], [ "<$u>" ],
+               'List-Archive: set');
+       is_deeply([ $mime->header('List-Post') ], [ '<mailto:a@example.com>' ],
+               'List-Post: set');
+       is_deeply([ $mime->header('Newsgroups') ], [ 'test' ],
+               'Newsgroups: set');
+       is_deeply([ $mime->header('Xref') ], [ 'example.com test:1' ],
+               'Xref: set');
+
+       $ng->{url} = 'http://mirror.example.com/m/';
+       PublicInbox::NNTP::set_nntp_headers($mime->header_obj, $ng, 2, $mid);
+       is_deeply([ $mime->header('Message-ID') ], [ "<$mid>" ],
+               'Message-ID unchanged');
+       is_deeply([ $mime->header('Archived-At') ],
+               [ "<${u}a%40b/>", '<http://mirror.example.com/m/a%40b/>' ],
+               'Archived-At: appended');
+       is_deeply([ $mime->header('Xref') ], [ 'example.com test:2' ],
+               'Old Xref: clobbered');
+}
+
 done_testing();