[PATCH 1/3] http: remove needless binmode call

[PATCH 1/3] http: remove needless binmode call

[ew]

From: Eric Wong <e@80x24.org>

Unnecessary on *nix, and we won't support systems
which do insane things.
---
 lib/PublicInbox/HTTP.pm | 1 -
 1 file changed, 1 deletion(-)

diff --git a/lib/PublicInbox/HTTP.pm b/lib/PublicInbox/HTTP.pm
index 414fc73..aa607b4 100644
--- a/lib/PublicInbox/HTTP.pm
+++ b/lib/PublicInbox/HTTP.pm
@@ -254,7 +254,6 @@ sub input_prepare {
 	# TODO: expire idle clients on ENFILE / EMFILE
 	return unless $input;
 
-	binmode $input;
 	$env->{'psgi.input'} = $input;
 	$self->{env} = $env;
 	$self->{input_left} = $len || 0;
-- 
EW

[PATCH 2/3] view: disable subject threading

[ew]

From: Eric Wong <e@80x24.org>

Broken threads should be exposed to hopefully encourage people to
use proper mail clients which set In-Reply-To headers.
---
 lib/PublicInbox/SearchView.pm | 17 +++++++----------
 lib/PublicInbox/Thread.pm     | 14 ++++++++++++++
 lib/PublicInbox/View.pm       | 16 +++-------------
 3 files changed, 24 insertions(+), 23 deletions(-)

diff --git a/lib/PublicInbox/SearchView.pm b/lib/PublicInbox/SearchView.pm
index 41d3200..c0cd1ff 100644
--- a/lib/PublicInbox/SearchView.pm
+++ b/lib/PublicInbox/SearchView.pm
@@ -11,6 +11,7 @@ use PublicInbox::View;
 use PublicInbox::MID qw(mid2path mid_clean mid_mime);
 use Email::MIME;
 require PublicInbox::Git;
+require PublicInbox::Thread;
 our $LIM = 50;
 
 sub sres_top_html {
@@ -151,23 +152,19 @@ sub tdump {
 	} ($mset->items);
 
 	my @rootset;
-	my $th = PublicInbox::View::thread_results(\@m, 0, $q->{r});
-	if ($q->{r}) {
+	my $th = PublicInbox::Thread->new(@m);
+	$th->thread;
+	if ($q->{r}) { # order by relevance
 		$th->order(sub {
 			sort { (eval { $pct{$b->topmost->messageid} } || 0)
 					<=>
 				(eval { $pct{$a->topmost->messageid} } || 0)
 			} @_;
 		});
-		@rootset = $th->rootset;
-	} else {
-		@rootset = sort {
-			(eval { $b->topmost->message->header('X-PI-TS') } || 0)
-				<=>
-			(eval { $a->topmost->message->header('X-PI-TS') } || 0)
-		} $th->rootset;
+	} else { # order by time (default for threaded view)
+		$th->order(*PublicInbox::View::sort_ts);
 	}
-
+	@rootset = $th->rootset;
 	my $git = $ctx->{git} ||= PublicInbox::Git->new($ctx->{git_dir});
 	my $state = {
 		ctx => $ctx,
diff --git a/lib/PublicInbox/Thread.pm b/lib/PublicInbox/Thread.pm
index 781ffff..44a565a 100644
--- a/lib/PublicInbox/Thread.pm
+++ b/lib/PublicInbox/Thread.pm
@@ -12,6 +12,20 @@ package PublicInbox::Thread;
 use strict;
 use warnings;
 use base qw(Mail::Thread);
+# WARNING! both these Mail::Thread knobs were found by inspecting
+# the Mail::Thread 2.55 source code, and we have some monkey patches
+# in PublicInbox::Thread to fix memory leaks.  Since Mail::Thread
+# appears unmaintained, I suppose it's safe to depend on these
+# variables for now:
+{
+	no warnings 'once';
+	# we want strict threads to expose (and hopefully discourage)
+	# use of broken email clients
+	$Mail::Thread::nosubject = 1;
+	# Keep ghosts with only a single direct child,
+	# don't hide that there may be missing messages.
+	$Mail::Thread::noprune = 1;
+}
 
 if ($Mail::Thread::VERSION <= 2.55) {
 	eval q(sub _container_class { 'PublicInbox::Thread::Container' });
diff --git a/lib/PublicInbox/View.pm b/lib/PublicInbox/View.pm
index 63810dc..70eb44e 100644
--- a/lib/PublicInbox/View.pm
+++ b/lib/PublicInbox/View.pm
@@ -670,21 +670,11 @@ sub msg_timestamp {
 }
 
 sub thread_results {
-	my ($msgs, $nosubject, $nosort) = @_;
+	my ($msgs) = @_;
 	require PublicInbox::Thread;
 	my $th = PublicInbox::Thread->new(@$msgs);
-
-	# WARNING! both these Mail::Thread knobs were found by inspecting
-	# the Mail::Thread 2.55 source code, and we have some monkey patches
-	# in PublicInbox::Thread to fix memory leaks.  Since Mail::Thread
-	# appears unmaintained, I suppose it's safe to depend on these
-	# variables for now:
-	no warnings 'once';
-	$Mail::Thread::nosubject = $nosubject;
-	# Keep ghosts with only a single direct child:
-	$Mail::Thread::noprune = 1;
 	$th->thread;
-	$th->order(*sort_ts) unless $nosort;
+	$th->order(*sort_ts);
 	$th
 }
 
@@ -879,7 +869,7 @@ sub emit_index_topics {
 		my $sres = $state->{srch}->query('', \%opts);
 		my $nr = scalar @{$sres->{msgs}} or last;
 
-		for (thread_results(load_results($sres), 1)->rootset) {
+		for (thread_results(load_results($sres))->rootset) {
 			add_topic($state, $_, 0);
 		}
 		$opts{offset} += $nr;
-- 
EW

[PATCH 3/3] nntp: append Archived-At and List-Archive headers

[ew]

From: Eric Wong <e@80x24.org>

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 ++++++++++-
 t/nntp.t                     | 34 ++++++++++++++++++++++++++++++++++
 4 files changed, 71 insertions(+), 4 deletions(-)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index e143d15..a31a765 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',
@@ -409,6 +410,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};
@@ -451,8 +475,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 85109ea..2c84fb3 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 adac919..98a3595 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;
diff --git a/t/nntp.t b/t/nntp.t
index 388620e..5513c7b 100644
--- 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();
-- 
EW