From a0acd80571373595838617034540e1503f744737 Mon Sep 17 00:00:00 2001
From: Eric Wong <e@80x24.org>
Date: Mon, 2 May 2016 04:22:40 +0000
Subject: 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.
---
 lib/PublicInbox/NNTP.pm      | 27 +++++++++++++++++++++++++--
 lib/PublicInbox/NNTPD.pm     |  3 ++-
 lib/PublicInbox/NewsGroup.pm | 11 ++++++++++-
 3 files changed, 37 insertions(+), 4 deletions(-)

(limited to 'lib/PublicInbox')

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index a4cf25e2..3e0faaf9 100644
--- 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 85109ea7..2c84fb30 100644
--- 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 adac919f..98a3595a 100644
--- 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;
-- 
cgit v1.2.3-24-ge0c7