[PATCH 0/12] nntp: misc updates

[PATCH 0/12] nntp: misc updates

[Eric Wong]

Still not changing or adding new caches or modifying our data layout,
but things seem to work well for the common case.

The most important change is the new long response API which will help
us even after any future optimizations we make.  We should be able to
stream millions of messages without excessive buffering and memory
usage.

Eric Wong (12):
      nntp: use write_buf_size instead write_buf
      nntp: introduce long response API for streaming
      nntp: use long response API for LISTGROUP
      nntp: implement command argument checking
      nntp: XOVER does not require range
      nntp: speed up XHDR for the Message-ID case
      nntp: implement XROVER, speed up XHDR for some cases
      nntp: implement XPATH
      nntp: fix logging of long responses
      nntp: fix ARTICLE/HEAD/BODY/STAT
      nntp: log to FDs given by the Nntpd module
      nntp: article lookups by Message-ID may cross newsgroups

 lib/PublicInbox/Msgmap.pm    |  24 +--
 lib/PublicInbox/NNTP.pm      | 419 ++++++++++++++++++++++++++++++++-----------
 lib/PublicInbox/SearchMsg.pm |   1 +
 public-inbox-nntpd           |   2 +
 4 files changed, 330 insertions(+), 116 deletions(-)

[PATCH 01/12] nntp: use write_buf_size instead write_buf

[Eric Wong]

It is shorter code and probably faster than checking an
array.
---
 lib/PublicInbox/NNTP.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index f1aaed4..807b49f 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -514,7 +514,7 @@ use constant MSG_MORE => ($^O eq 'linux') ? 0x8000 : 0;
 
 sub do_more {
 	my ($self, $data) = @_;
-	if (MSG_MORE && !scalar @{$self->{write_buf}}) {
+	if (MSG_MORE && !$self->{write_buf_size}) {
 		my $n = send($self->{sock}, $data, MSG_MORE);
 		if (defined $n) {
 			my $dlen = bytes::length($data);
-- 
EW

[PATCH 02/12] nntp: introduce long response API for streaming

[Eric Wong]

XOVER, NEWNEWS, XHDR responses may be arbitrarily long and cause
memory usage via buffering.  This problem would exist even if we
were to optimize them by caching headers for fast retrieval and
search.

Introduce a generic API to handle all of these commands fairly
without triggering excessive buffering and unfairness of the
existing implementation.

Generating these responses is still expensive for now, but at least
the implementation is fair to other clients and prevents one client
from using one of these commands to monopolize resources away from
other clients.
---
 lib/PublicInbox/NNTP.pm | 105 ++++++++++++++++++++++++++++++++++++------------
 1 file changed, 80 insertions(+), 25 deletions(-)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 807b49f..f86c633 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -4,13 +4,14 @@ package PublicInbox::NNTP;
 use strict;
 use warnings;
 use base qw(Danga::Socket);
-use fields qw(nntpd article ng);
+use fields qw(nntpd article ng long_res);
 use PublicInbox::Msgmap;
 use PublicInbox::GitCatFile;
 use PublicInbox::MID qw(mid2path);
 use Email::Simple;
 use Data::Dumper qw(Dumper);
 use POSIX qw(strftime);
+use Time::HiRes qw(gettimeofday tv_interval ualarm);
 use constant {
 	r501 => '501 command syntax error',
 };
@@ -233,26 +234,38 @@ sub cmd_newnews {
 	my ($keep, $skip) = split('!', $newsgroups, 2);
 	ngpat2re($keep);
 	ngpat2re($skip);
-	$ts .= '..';
-
-	my $opts = { asc => 1, limit => 1000 };
+	my @srch;
 	foreach my $ng (values %{$self->{nntpd}->{groups}}) {
 		$ng->{name} =~ $keep or next;
 		$ng->{name} =~ $skip and next;
 		my $srch = $ng->search or next;
-		$opts->{offset} = 0;
+		push @srch, $srch;
+	};
+	return '.' unless @srch;
 
-		while (1) {
-			my $res = $srch->query($ts, $opts);
-			my $msgs = $res->{msgs};
-			my $nr = scalar @$msgs or last;
+	$ts .= '..';
+	my $opts = { asc => 1, limit => 1000, offset => 0 };
+
+	my $end = 0xffffffff; # would like to read 4 billion messages?
+	$self->long_response(0, $end, sub {
+		my ($i) = @_;
+		my $srch = $srch[0];
+		my $res = $srch->query($ts, $opts);
+		my $msgs = $res->{msgs};
+		if (my $nr = scalar @$msgs) {
 			more($self, '<' .
 				join(">\r\n<", map { $_->mid } @$msgs ).
 				'>');
 			$opts->{offset} += $nr;
+		} else {
+			shift @srch;
+			if (@srch) { # continue onto next newsgroup
+				$opts->{offset} = 0;
+			} else { # break out of the long response.
+				$$i = $end;
+			}
 		}
-	}
-	'.';
+	});
 }
 
 sub cmd_group {
@@ -441,6 +454,48 @@ sub xhdr {
 	$r;
 }
 
+sub long_response {
+	my ($self, $beg, $end, $cb) = @_;
+	die "BUG: nested long response" if $self->{long_res};
+
+	# make sure we disable reading during a long response,
+	# clients should not be sending us stuff and making us do more
+	# work while we are stream a response to them
+	$self->watch_read(0);
+	$self->{long_res} = sub {
+		# limit our own running time for fairness with other
+		# clients and to avoid buffering too much:
+		my $yield;
+		local $SIG{ALRM} = sub { $yield = 1 };
+		ualarm(100000);
+
+		my $err;
+		do {
+			eval { $cb->(\$beg) };
+		} until (($err = $@) || $self->{closed} || $yield ||
+			 $self->{write_buf_size} || ++$beg > $end);
+		ualarm(0);
+
+		if ($err || $self->{closed}) {
+			$self->{long_res} = undef;
+			warning("$err during long response") if $err;
+			$self->watch_read(1) unless $self->{closed};
+		} elsif ($yield || $self->{write_buf_size}) {
+			# no recursion, schedule another call ASAP
+			# but only after all pending writes are done
+			Danga::Socket->AddTimer(0, sub {
+				$self->write($self->{long_res});
+			});
+		} else { # all done!
+			$self->{long_res} = undef;
+			$self->watch_read(1);
+			res($self, '.');
+		}
+	};
+	$self->{long_res}->(); # kick off!
+	undef;
+}
+
 sub cmd_xhdr {
 	my ($self, $header, $range) = @_;
 	defined $self->{ng} or return '412 no news group currently selected';
@@ -455,19 +510,20 @@ sub cmd_xhdr {
 		if (defined($r = xhdr($r, $header))) {
 			more($self, "<$range> $r");
 		}
+		'.';
 	} else { # numeric range
 		my $r = get_range($self, $range);
 		return $r unless ref $r;
 		my ($beg, $end) = @$r;
 		more($self, '221 Header follows');
-		foreach my $i ($beg..$end) {
-			$r = $self->art_lookup($i, 2);
-			next unless ref $r;
-			defined($r = xhdr($r, $header)) or next;
-			more($self, "$i $r");
-		}
+		$self->long_response($beg, $end, sub {
+			my ($i) = @_;
+			$r = $self->art_lookup($$i, 2);
+			return unless ref $r;
+			defined($r = xhdr($r, $header)) or return;
+			more($self, "$$i $r");
+		});
 	}
-	'.';
 }
 
 sub cmd_xover {
@@ -476,16 +532,16 @@ sub cmd_xover {
 	return $r unless ref $r;
 	my ($beg, $end) = @$r;
 	more($self, "224 Overview information follows for $beg to $end");
-	foreach my $i ($beg..$end) {
-		my $r = $self->art_lookup($i, 2);
-		next unless ref $r;
+	$self->long_response($beg, $end, sub {
+		my ($i) = @_;
+		my $r = $self->art_lookup($$i, 2);
+		return unless ref $r;
 		more($self, join("\t", $r->[0],
 				map {
 					my $h = xhdr($r, $_);
 					defined $h ? $h : '';
 				} @OVERVIEW ));
-	}
-	'.';
+	});
 }
 
 sub res {
@@ -505,7 +561,7 @@ sub do_write {
 
 	# Do not watch for readability if we have data in the queue,
 	# instead re-enable watching for readability when we can
-	$self->watch_read(0) unless $done;
+	$self->watch_read(0) if (!$done || $self->{long_res});
 
 	$done;
 }
@@ -539,7 +595,6 @@ sub event_write {
 sub event_read {
 	my ($self) = @_;
 	use constant LINE_MAX => 512; # RFC 977 section 2.3
-	use Time::HiRes qw(gettimeofday tv_interval);
 	my $r = 1;
 	my $buf = $self->read(LINE_MAX) or return $self->close;
 	while ($r > 0 && $$buf =~ s/\A([^\r\n]+)\r?\n//) {
-- 
EW

[PATCH 03/12] nntp: use long response API for LISTGROUP

[Eric Wong]

LISTGROUP can be expensive for giant groups, too.  Use the
long response API to improve fairness and prevent excessive
buffering.
---
 lib/PublicInbox/Msgmap.pm | 24 ++++++++----------------
 lib/PublicInbox/NNTP.pm   | 23 +++++++++++++----------
 2 files changed, 21 insertions(+), 26 deletions(-)

diff --git a/lib/PublicInbox/Msgmap.pm b/lib/PublicInbox/Msgmap.pm
index c0fc636..2f64d90 100644
--- a/lib/PublicInbox/Msgmap.pm
+++ b/lib/PublicInbox/Msgmap.pm
@@ -155,25 +155,17 @@ sub create_tables {
 			'val VARCHAR(255) NOT NULL)');
 }
 
-sub each_id_batch {
-	my ($self, $cb) = @_;
+sub id_batch {
+	my ($self, $num, $cb) = @_;
 	my $dbh = $self->{dbh};
-	my $n = 0;
-	my $total = 0;
-	my $nr;
 	my $sth = $dbh->prepare('SELECT num FROM msgmap WHERE num > ? '.
 				'ORDER BY num ASC LIMIT 1000');
-	while (1) {
-		$sth->execute($n);
-		my $ary = $sth->fetchall_arrayref;
-		@$ary = map { $_->[0] } @$ary;
-		$nr = scalar @$ary;
-		last if $nr == 0;
-		$total += $nr;
-		$n = $ary->[-1];
-		$cb->($ary);
-	}
-	$total;
+	$sth->execute($num);
+	my $ary = $sth->fetchall_arrayref;
+	@$ary = map { $_->[0] } @$ary;
+	my $nr = scalar @$ary;
+	$cb->($ary) if $nr;
+	$nr;
 }
 
 1;
diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index f86c633..5d770bd 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -14,6 +14,7 @@ use POSIX qw(strftime);
 use Time::HiRes qw(gettimeofday tv_interval ualarm);
 use constant {
 	r501 => '501 command syntax error',
+	long_response_limit => 0xffffffff,
 };
 
 my @OVERVIEW = qw(Subject From Date Message-ID References Bytes Lines);
@@ -142,13 +143,17 @@ sub cmd_listgroup {
 		more($self, $res);
 	}
 
-	my $ng = $self->{ng} or return '412 no newsgroup selected';
-	# Ugh this can be silly expensive for big groups
-	$ng->mm->each_id_batch(sub {
-		my ($ary) = @_;
-		more($self, join("\r\n", @$ary));
+	$self->{ng} or return '412 no newsgroup selected';
+	$self->long_response(0, long_response_limit, sub {
+		my ($i) = @_;
+		my $nr = $self->{ng}->mm->id_batch($$i, sub {
+			my ($ary) = @_;
+			more($self, join("\r\n", @$ary));
+		});
+
+		# -1 to adjust for implicit increment in long_response
+		$$i = $nr ? $$i + $nr - 1 : long_response_limit;
 	});
-	'.'
 }
 
 sub parse_time {
@@ -245,9 +250,7 @@ sub cmd_newnews {
 
 	$ts .= '..';
 	my $opts = { asc => 1, limit => 1000, offset => 0 };
-
-	my $end = 0xffffffff; # would like to read 4 billion messages?
-	$self->long_response(0, $end, sub {
+	$self->long_response(0, long_response_limit, sub {
 		my ($i) = @_;
 		my $srch = $srch[0];
 		my $res = $srch->query($ts, $opts);
@@ -262,7 +265,7 @@ sub cmd_newnews {
 			if (@srch) { # continue onto next newsgroup
 				$opts->{offset} = 0;
 			} else { # break out of the long response.
-				$$i = $end;
+				$$i = long_response_limit;
 			}
 		}
 	});
-- 
EW

[PATCH 04/12] nntp: implement command argument checking

[Eric Wong]

Validate commands to make sure we do not accidentally screw up
some things or leave out some argument checking.
---
 lib/PublicInbox/NNTP.pm | 112 +++++++++++++++++++++++++-----------------------
 1 file changed, 59 insertions(+), 53 deletions(-)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 5d770bd..7a73573 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -24,7 +24,7 @@ my %OVERVIEW = map { $_ => 1 } @OVERVIEW;
 # LISTGROUP could get pretty bad, too...
 my %DISABLED; # = map { $_ => 1 } qw(xover list_overview_fmt newnews xhdr);
 
-sub new {
+sub new ($$$) {
 	my ($class, $sock, $nntpd) = @_;
 	my $self = fields::new($class);
 	$self->SUPER::new($sock);
@@ -34,8 +34,17 @@ sub new {
 	$self;
 }
 
+sub args_ok ($$) {
+	my ($cb, $argc) = @_;
+	my $tot = prototype $cb;
+	my ($nreq, undef) = split(';', $tot);
+	$nreq = ($nreq =~ tr/$//) - 1;
+	$tot = ($tot =~ tr/$//) - 1;
+	($argc <= $tot && $argc >= $nreq);
+}
+
 # returns 1 if we can continue, 0 if not due to buffered writes or disconnect
-sub process_line {
+sub process_line ($$) {
 	my ($self, $l) = @_;
 	my ($req, @args) = split(/\s+/, $l);
 	$req = lc($req);
@@ -44,6 +53,7 @@ sub process_line {
 		$req = $DISABLED{$req} ? undef : *{'cmd_'.$req}{CODE};
 	};
 	return res($self, '500 command not recognized') unless $req;
+	return res($self, r501) unless args_ok($req, scalar @args);
 
 	my $res = eval { $req->($self, @args) };
 	my $err = $@;
@@ -56,33 +66,28 @@ sub process_line {
 	res($self, $res);
 }
 
-sub cmd_mode {
+sub cmd_mode ($$) {
 	my ($self, $arg) = @_;
-	return r501 unless defined $arg;
 	$arg = uc $arg;
 	return r501 unless $arg eq 'READER';
 	'200 reader status acknowledged';
 }
 
-sub cmd_slave {
-	my ($self, @x) = @_;
-	return r501 if @x;
-	'202 slave status noted';
-}
+sub cmd_slave ($) { '202 slave status noted' }
 
-sub cmd_xgtitle {
+sub cmd_xgtitle ($;$) {
 	my ($self, $wildmat) = @_;
 	more($self, '282 list of groups and descriptions follows');
 	list_newsgroups($self, $wildmat);
 	'.'
 }
 
-sub list_overview_fmt {
+sub list_overview_fmt ($$) {
 	my ($self) = @_;
 	more($self, $_ . ':') foreach @OVERVIEW;
 }
 
-sub list_active {
+sub list_active ($;$) {
 	my ($self, $wildmat) = @_;
 	wildmat2re($wildmat);
 	foreach my $ng (values %{$self->{nntpd}->{groups}}) {
@@ -91,7 +96,7 @@ sub list_active {
 	}
 }
 
-sub list_active_times {
+sub list_active_times ($;$) {
 	my ($self, $wildmat) = @_;
 	wildmat2re($wildmat);
 	foreach my $ng (values %{$self->{nntpd}->{groups}}) {
@@ -101,7 +106,7 @@ sub list_active_times {
 	}
 }
 
-sub list_newsgroups {
+sub list_newsgroups ($;$) {
 	my ($self, $wildmat) = @_;
 	wildmat2re($wildmat);
 	foreach my $ng (values %{$self->{nntpd}->{groups}}) {
@@ -112,20 +117,21 @@ sub list_newsgroups {
 }
 
 # LIST SUBSCRIPTIONS not supported
-sub cmd_list {
-	my ($self, $arg, $wildmat, @x) = @_;
-	if (defined $arg) {
-		$arg = lc $arg;
-		$arg =~ tr/./_/;
+sub cmd_list ($;$$) {
+	my ($self, @args) = @_;
+	if (scalar @args) {
+		my $arg = shift @args;
+		$arg =~ tr/A-Z./a-z_/;
 		$arg = "list_$arg";
 		return '503 function not performed' if $DISABLED{$arg};
+
 		$arg = eval {
 			no strict 'refs';
 			*{$arg}{CODE};
 		};
-		return r501 unless $arg;
+		return r501 unless $arg && args_ok($arg, scalar @args);
 		more($self, '215 information follows');
-		$arg->($self, $wildmat, @x);
+		$arg->($self, @args);
 	} else {
 		more($self, '215 list of newsgroups follows');
 		foreach my $ng (values %{$self->{nntpd}->{groups}}) {
@@ -135,7 +141,7 @@ sub cmd_list {
 	'.'
 }
 
-sub cmd_listgroup {
+sub cmd_listgroup ($;$) {
 	my ($self, $group) = @_;
 	if (defined $group) {
 		my $res = cmd_group($self, $group);
@@ -156,7 +162,7 @@ sub cmd_listgroup {
 	});
 }
 
-sub parse_time {
+sub parse_time ($$;$) {
 	my ($date, $time, $gmt) = @_;
 	use Time::Local qw();
 	my ($YY, $MM, $DD) = unpack('A2A2A2', $date);
@@ -178,13 +184,13 @@ sub parse_time {
 	}
 }
 
-sub group_line {
+sub group_line ($$) {
 	my ($self, $ng) = @_;
 	my ($min, $max) = $ng->mm->minmax;
 	more($self, "$ng->{name} $max $min n") if defined $min && defined $max;
 }
 
-sub cmd_newgroups {
+sub cmd_newgroups ($$$;$$) {
 	my ($self, $date, $time, $gmt, $dists) = @_;
 	my $ts = eval { parse_time($date, $time, $gmt) };
 	return r501 if $@;
@@ -199,7 +205,7 @@ sub cmd_newgroups {
 	'.'
 }
 
-sub wildmat2re {
+sub wildmat2re (;$) {
 	return $_[0] = qr/.*/ if (!defined $_[0] || $_[0] eq '*');
 	my %keep;
 	my $salt = rand;
@@ -224,14 +230,14 @@ sub wildmat2re {
 	$_[0] = qr/\A$tmp\z/;
 }
 
-sub ngpat2re {
+sub ngpat2re (;$) {
 	return $_[0] = qr/\A\z/ unless defined $_[0];
 	my %map = ('*' => '.*', ',' => '|');
 	$_[0] =~ s!(.)!$map{$1} || "\Q$1"!ge;
 	$_[0] = qr/\A(?:$_[0])\z/;
 }
 
-sub cmd_newnews {
+sub cmd_newnews ($$$$;$$) {
 	my ($self, $newsgroups, $date, $time, $gmt, $dists) = @_;
 	my $ts = eval { parse_time($date, $time, $gmt) };
 	return r501 if $@;
@@ -271,7 +277,7 @@ sub cmd_newnews {
 	});
 }
 
-sub cmd_group {
+sub cmd_group ($$) {
 	my ($self, $group) = @_;
 	my $no_such = '411 no such news group';
 	my $ng = $self->{nntpd}->{groups}->{$group} or return $no_such;
@@ -285,7 +291,7 @@ sub cmd_group {
 	"211 $est_size $min $max $group";
 }
 
-sub article_adj {
+sub article_adj ($$) {
 	my ($self, $off) = @_;
 	my $ng = $self->{ng} or return '412 no newsgroup selected';
 
@@ -302,25 +308,25 @@ sub article_adj {
 	"223 $n <$mid> article retrieved - request text separately";
 }
 
-sub cmd_next { article_adj($_[0], 1) }
-sub cmd_last { article_adj($_[0], -1) }
+sub cmd_next ($) { article_adj($_[0], 1) }
+sub cmd_last ($) { article_adj($_[0], -1) }
 
 # We want to encourage using email and CC-ing everybody involved to avoid
 # the single-point-of-failure a single server provides.
-sub cmd_post {
+sub cmd_post ($) {
 	my ($self) = @_;
 	my $ng = $self->{ng};
 	$ng ? "440 mailto:$ng->{address} to post" : '440 posting not allowed'
 }
 
-sub cmd_quit {
+sub cmd_quit ($) {
 	my ($self) = @_;
 	res($self, '205 closing connection - goodbye!');
 	$self->close;
 	undef;
 }
 
-sub art_lookup {
+sub art_lookup ($$$) {
 	my ($self, $art, $set_headers) = @_;
 	my $ng = $self->{ng} or return '412 no newsgroup has been selected';
 	my ($n, $mid);
@@ -364,7 +370,7 @@ find_mid:
 	[ $n, $mid, $s ];
 }
 
-sub simple_body_write {
+sub simple_body_write ($$) {
 	my ($self, $s) = @_;
 	my $body = $s->body;
 	$s->body_set('');
@@ -373,14 +379,14 @@ sub simple_body_write {
 	'.'
 }
 
-sub header_str {
+sub header_str ($) {
 	my ($s) = @_;
 	my $h = $s->header_obj;
 	$h->header_set('Bytes');
 	$h->as_string
 }
 
-sub cmd_article {
+sub cmd_article ($$) {
 	my ($self, $art) = @_;
 	my $r = $self->art_lookup($art, 1);
 	return $r unless ref $r;
@@ -391,7 +397,7 @@ sub cmd_article {
 	simple_body_write($self, $s);
 }
 
-sub cmd_head {
+sub cmd_head ($$) {
 	my ($self, $art) = @_;
 	my $r = $self->art_lookup($art, 2);
 	return $r unless ref $r;
@@ -401,7 +407,7 @@ sub cmd_head {
 	'.'
 }
 
-sub cmd_body {
+sub cmd_body ($$) {
 	my ($self, $art) = @_;
 	my $r = $self->art_lookup($art, 0);
 	return $r unless ref $r;
@@ -410,7 +416,7 @@ sub cmd_body {
 	simple_body_write($self, $s);
 }
 
-sub cmd_stat {
+sub cmd_stat ($$) {
 	my ($self, $art) = @_;
 	my $r = $self->art_lookup($art, 0);
 	return $r unless ref $r;
@@ -418,17 +424,17 @@ sub cmd_stat {
 	"223 $n <$mid> article retrieved - request text separately";
 }
 
-sub cmd_ihave { '435 article not wanted - do not send it' }
+sub cmd_ihave ($) { '435 article not wanted - do not send it' }
 
-sub cmd_date { '111 '.strftime('%Y%m%d%H%M%S', gmtime(time)) }
+sub cmd_date ($) { '111 '.strftime('%Y%m%d%H%M%S', gmtime(time)) }
 
-sub cmd_help {
+sub cmd_help ($) {
 	my ($self) = @_;
 	more($self, '100 help text follows');
 	'.'
 }
 
-sub get_range {
+sub get_range ($;$) {
 	my ($self, $range) = @_;
 	my $ng = $self->{ng} or return '412 no news group has been selected';
 	defined $range or return '420 No article(s) selected';
@@ -449,7 +455,7 @@ sub get_range {
 	[ $beg, $end ];
 }
 
-sub xhdr {
+sub xhdr ($$) {
 	my ($r, $header) = @_;
 	$r = $r->[2]->header_obj->header($header);
 	defined $r or return;
@@ -457,7 +463,7 @@ sub xhdr {
 	$r;
 }
 
-sub long_response {
+sub long_response ($$$$) {
 	my ($self, $beg, $end, $cb) = @_;
 	die "BUG: nested long response" if $self->{long_res};
 
@@ -499,7 +505,7 @@ sub long_response {
 	undef;
 }
 
-sub cmd_xhdr {
+sub cmd_xhdr ($$;$) {
 	my ($self, $header, $range) = @_;
 	defined $self->{ng} or return '412 no news group currently selected';
 	unless (defined $range) {
@@ -529,7 +535,7 @@ sub cmd_xhdr {
 	}
 }
 
-sub cmd_xover {
+sub cmd_xover ($;$) {
 	my ($self, $range) = @_;
 	my $r = get_range($self, $range);
 	return $r unless ref $r;
@@ -547,17 +553,17 @@ sub cmd_xover {
 	});
 }
 
-sub res {
+sub res ($$) {
 	my ($self, $line) = @_;
 	do_write($self, $line . "\r\n");
 }
 
-sub more {
+sub more ($$) {
 	my ($self, $line) = @_;
 	do_more($self, $line . "\r\n");
 }
 
-sub do_write {
+sub do_write ($$) {
 	my ($self, $data) = @_;
 	my $done = $self->write($data);
 	die if $self->{closed};
@@ -571,7 +577,7 @@ sub do_write {
 
 use constant MSG_MORE => ($^O eq 'linux') ? 0x8000 : 0;
 
-sub do_more {
+sub do_more ($$) {
 	my ($self, $data) = @_;
 	if (MSG_MORE && !$self->{write_buf_size}) {
 		my $n = send($self->{sock}, $data, MSG_MORE);
-- 
EW

[PATCH 05/12] nntp: XOVER does not require range

[Eric Wong]

XOVER uses the current article if no range is given as
stipulated in RFC 2980.
---
 lib/PublicInbox/NNTP.pm | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 7a73573..8275ef0 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -434,7 +434,7 @@ sub cmd_help ($) {
 	'.'
 }
 
-sub get_range ($;$) {
+sub get_range ($$) {
 	my ($self, $range) = @_;
 	my $ng = $self->{ng} or return '412 no news group has been selected';
 	defined $range or return '420 No article(s) selected';
@@ -508,11 +508,7 @@ sub long_response ($$$$) {
 sub cmd_xhdr ($$;$) {
 	my ($self, $header, $range) = @_;
 	defined $self->{ng} or return '412 no news group currently selected';
-	unless (defined $range) {
-		defined($range = $self->{article}) or
-			return '420 no current article has been selected';
-	}
-	if ($range =~ /\A<(.+)>\z/) { # Message-ID
+	if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
 		my $r = $self->art_lookup($range, 2);
 		return $r unless ref $r;
 		more($self, '221 Header follows');
@@ -521,6 +517,7 @@ sub cmd_xhdr ($$;$) {
 		}
 		'.';
 	} else { # numeric range
+		$range = $self->{article} unless defined $range;
 		my $r = get_range($self, $range);
 		return $r unless ref $r;
 		my ($beg, $end) = @$r;
@@ -537,6 +534,7 @@ sub cmd_xhdr ($$;$) {
 
 sub cmd_xover ($;$) {
 	my ($self, $range) = @_;
+	$range = $self->{article} unless defined $range;
 	my $r = get_range($self, $range);
 	return $r unless ref $r;
 	my ($beg, $end) = @$r;
-- 
EW

[PATCH 06/12] nntp: speed up XHDR for the Message-ID case

[Eric Wong]

We can use our msgmap database to implement "XHDR Message-ID [range]"
commands quickly.  This helps immensely with slrnpull, which prefers
XHDR to LISTGROUP for some reason...
---
 lib/PublicInbox/NNTP.pm | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 8275ef0..47b03e0 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -505,9 +505,45 @@ sub long_response ($$$$) {
 	undef;
 }
 
+sub xhdr_message_id ($$) { # optimize XHDR Message-ID [range] for slrnpull.
+	my ($self, $range) = @_;
+
+	my $mm = $self->{ng}->mm;
+	if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
+		my $n = $mm->num_for($range);
+		more($self, '221 Header follows');
+		more($self, "<$range> <$range>") if defined $n;
+		'.';
+	} else { # numeric range
+		$range = $self->{article} unless defined $range;
+		my $r = get_range($self, $range);
+		return $r unless ref $r;
+		my ($beg, $end) = @$r;
+		more($self, '221 Header follows');
+		$self->long_response($beg, $end, sub {
+			my ($i) = @_;
+			my $mid = $mm->mid_for($$i);
+			more($self, "$$i <$mid>") if defined $mid;
+		});
+	}
+}
+
 sub cmd_xhdr ($$;$) {
 	my ($self, $header, $range) = @_;
 	defined $self->{ng} or return '412 no news group currently selected';
+	my $sub = $header;
+	$sub =~ tr/A-Z-/a-z_/;
+	$sub = eval {
+		no strict 'refs';
+		$sub = *{'xhdr_'.$sub}{CODE};
+	};
+	return xhdr_slow($self, $header, $range) unless defined $sub;
+	$sub->($self, $range);
+}
+
+sub xhdr_slow ($$$) {
+	my ($self, $header, $range) = @_;
+
 	if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
 		my $r = $self->art_lookup($range, 2);
 		return $r unless ref $r;
-- 
EW

[PATCH 07/12] nntp: implement XROVER, speed up XHDR for some cases

[Eric Wong]

Using Xapian allows us to implement XROVER without forking
new processes.
---
 lib/PublicInbox/NNTP.pm      | 84 +++++++++++++++++++++++++++++++++++++++-----
 lib/PublicInbox/SearchMsg.pm |  1 +
 2 files changed, 76 insertions(+), 9 deletions(-)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 47b03e0..939fc3a 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -528,17 +528,61 @@ sub xhdr_message_id ($$) { # optimize XHDR Message-ID [range] for slrnpull.
 	}
 }
 
+sub header_obj_for {
+	my ($srch, $mid) = @_;
+	eval {
+		my $smsg = $srch->lookup_message($mid);
+		$smsg = PublicInbox::SearchMsg->load_doc($smsg->{doc});
+		$smsg->mini_mime->header_obj;
+	};
+};
+
+sub xhdr_searchmsg ($$$) {
+	my ($self, $sub, $range) = @_;
+	my $srch = $self->{ng}->search;
+	my $emit = ($sub eq 'date') ? sub {
+		my ($pfx, $m) = @_;
+		my @t = gmtime($m->header('X-PI-TS'));
+		more($self, "$pfx ". strftime('%a, %d %b %Y %T %z', @t));
+	} : sub {
+		my ($pfx, $m) = @_;
+		my $h = $m->header($sub);
+		more($self, "$pfx $h") if defined $h;
+	};
+
+	if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
+		more($self, '221 Header follows');
+		my $m = header_obj_for($srch, $1);
+		$emit->($range, $m) if defined $m;
+		'.';
+	} else { # numeric range
+		$range = $self->{article} unless defined $range;
+		my $mm = $self->{ng}->mm;
+		my $r = get_range($self, $range);
+		return $r unless ref $r;
+		my ($beg, $end) = @$r;
+		more($self, '221 Header follows');
+		$self->long_response($beg, $end, sub {
+			my ($i) = @_;
+			my $mid = $mm->mid_for($$i) or return;
+			my $m = header_obj_for($srch, $mid) or return;
+			$emit->($$i, $m);
+		});
+	}
+}
+
 sub cmd_xhdr ($$;$) {
 	my ($self, $header, $range) = @_;
-	defined $self->{ng} or return '412 no news group currently selected';
-	my $sub = $header;
-	$sub =~ tr/A-Z-/a-z_/;
-	$sub = eval {
-		no strict 'refs';
-		$sub = *{'xhdr_'.$sub}{CODE};
-	};
-	return xhdr_slow($self, $header, $range) unless defined $sub;
-	$sub->($self, $range);
+	my $ng = $self->{ng};
+	defined $ng or return '412 no news group currently selected';
+	my $sub = lc $header;
+	if ($sub eq 'message-id') {
+		xhdr_message_id($self, $range);
+	} elsif ($sub =~ /\A(subject|references|date)\z/ && $ng->search) {
+		xhdr_searchmsg($self, $sub, $range);
+	} else {
+		xhdr_slow($self, $header, $range);
+	}
 }
 
 sub xhdr_slow ($$$) {
@@ -568,6 +612,28 @@ sub xhdr_slow ($$$) {
 	}
 }
 
+sub cmd_xrover ($;$) {
+	my ($self, $range) = @_;
+	my $ng = $self->{ng} or return '412 no newsgroup selected';
+	(defined $range && $range =~ /[<>]/) and
+		return '420 No article(s) selected'; # no message IDs
+
+	$range = $self->{article} unless defined $range;
+	my $r = get_range($self, $range);
+	return $r unless ref $r;
+	my ($beg, $end) = @$r;
+	my $mm = $ng->mm;
+	my $srch = $ng->search;
+	more($self, '224 Overview information follows');
+	$self->long_response($beg, $end, sub {
+		my ($i) = @_;
+		my $mid = $mm->mid_for($$i) or return;
+		my $m = header_obj_for($srch, $mid) or return;
+		my $h = $m->header('references');
+		more($self, "$$i $h") if defined $h;
+	});
+}
+
 sub cmd_xover ($;$) {
 	my ($self, $range) = @_;
 	$range = $self->{article} unless defined $range;
diff --git a/lib/PublicInbox/SearchMsg.pm b/lib/PublicInbox/SearchMsg.pm
index e3a0460..8c55c92 100644
--- a/lib/PublicInbox/SearchMsg.pm
+++ b/lib/PublicInbox/SearchMsg.pm
@@ -141,6 +141,7 @@ sub mini_mime {
 		'X-PI-TS' => $self->ts,
 	);
 	if (my $refs = $self->{references_sorted}) {
+		$refs =~ s/></> </g;
 		push @h, References => $refs;
 	}
 	my $mime = Email::MIME->create(header_str => \@hs, header => \@h);
-- 
EW

[PATCH 08/12] nntp: implement XPATH

[Eric Wong]

This may be helpful for sorting out duplicates.
---
 lib/PublicInbox/NNTP.pm | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 939fc3a..094d26d 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -653,6 +653,19 @@ sub cmd_xover ($;$) {
 	});
 }
 
+sub cmd_xpath ($$) {
+	my ($self, $mid) = @_;
+	return r501 unless $mid =~ /\A<(.+)>\z/;
+	$mid = $1;
+	my @paths;
+	foreach my $ng (values %{$self->{nntpd}->{groups}}) {
+		my $n = $ng->mm->num_for($mid);
+		push @paths, "$ng->{name}/$n" if defined $n;
+	}
+	return '430 no such article on server' unless @paths;
+	'223 '.join(' ', @paths);
+}
+
 sub res ($$) {
 	my ($self, $line) = @_;
 	do_write($self, $line . "\r\n");
-- 
EW

[PATCH 09/12] nntp: fix logging of long responses

[Eric Wong]

It's misleading to show short times on long responses.
Instead, show the long response as a separate entry on
completion or failure.
---
 lib/PublicInbox/NNTP.pm | 33 +++++++++++++++++++++++++--------
 1 file changed, 25 insertions(+), 8 deletions(-)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 094d26d..3ded0de 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -11,12 +11,14 @@ use PublicInbox::MID qw(mid2path);
 use Email::Simple;
 use Data::Dumper qw(Dumper);
 use POSIX qw(strftime);
-use Time::HiRes qw(gettimeofday tv_interval ualarm);
+use Time::HiRes qw(clock_gettime ualarm CLOCK_MONOTONIC);
 use constant {
 	r501 => '501 command syntax error',
 	long_response_limit => 0xffffffff,
 };
 
+sub now () { clock_gettime(CLOCK_MONOTONIC) };
+
 my @OVERVIEW = qw(Subject From Date Message-ID References Bytes Lines);
 my %OVERVIEW = map { $_ => 1 } @OVERVIEW;
 
@@ -471,6 +473,8 @@ sub long_response ($$$$) {
 	# clients should not be sending us stuff and making us do more
 	# work while we are stream a response to them
 	$self->watch_read(0);
+	my $fd = fileno $self->{sock};
+	my $t0 = now();
 	$self->{long_res} = sub {
 		# limit our own running time for fairness with other
 		# clients and to avoid buffering too much:
@@ -487,8 +491,18 @@ sub long_response ($$$$) {
 
 		if ($err || $self->{closed}) {
 			$self->{long_res} = undef;
-			warning("$err during long response") if $err;
-			$self->watch_read(1) unless $self->{closed};
+
+			if ($err) {
+				warning("$err during long response[$fd] - ".
+					sprintf('%0.6', now() - $t0));
+			}
+			if ($self->{closed}) {
+				printf(STDERR
+				       " deferred[$fd] aborted - %0.6f\n",
+				       now() - $t0);
+			} else {
+				$self->watch_read(1);
+			}
 		} elsif ($yield || $self->{write_buf_size}) {
 			# no recursion, schedule another call ASAP
 			# but only after all pending writes are done
@@ -499,6 +513,8 @@ sub long_response ($$$$) {
 			$self->{long_res} = undef;
 			$self->watch_read(1);
 			res($self, '.');
+			printf(STDERR " deferred[$fd] done - %0.6f\n",
+				now() - $t0);
 		}
 	};
 	$self->{long_res}->(); # kick off!
@@ -719,12 +735,13 @@ sub event_read {
 	use constant LINE_MAX => 512; # RFC 977 section 2.3
 	my $r = 1;
 	my $buf = $self->read(LINE_MAX) or return $self->close;
-	while ($r > 0 && $$buf =~ s/\A([^\r\n]+)\r?\n//) {
+	while ($r > 0 && $$buf =~ s/\A\s*([^\r\n]+)\r?\n//) {
 		my $line = $1;
-		my $t0 = [ gettimeofday ];
+		my $t0 = now();
 		$r = eval { $self->process_line($line) };
-		printf(STDERR "$line %0.6f\n",
-			tv_interval($t0, [gettimeofday]));
+		my $d = $self->{long_res} ?
+			' deferred['.fileno($self->{sock}).']' : '';
+		printf(STDERR "$line - %0.6f$d\n", now() - $t0);
 	}
 	return $self->close if $r < 0;
 	my $len = bytes::length($$buf);
@@ -732,6 +749,6 @@ sub event_read {
 	$self->push_back_read($buf) if ($len);
 }
 
-sub warning { print STDERR @_, "\n" }
+sub warning { print STDERR 'W: ', @_, "\n" }
 
 1;
-- 
EW

[PATCH 10/12] nntp: fix ARTICLE/HEAD/BODY/STAT

[Eric Wong]

Article number is optional, but we need to update the
article number of the client connection if it was specified
(but not if it was given a Message-ID) as stipulated by
RFC 977
---
 lib/PublicInbox/NNTP.pm | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 3ded0de..01039ba 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -388,41 +388,50 @@ sub header_str ($) {
 	$h->as_string
 }
 
-sub cmd_article ($$) {
+sub set_art {
+	my ($self, $art) = @_;
+	$self->{article} = $art if defined $art && $art =~ /\A\d+\z/;
+}
+
+sub cmd_article ($;$) {
 	my ($self, $art) = @_;
 	my $r = $self->art_lookup($art, 1);
 	return $r unless ref $r;
 	my ($n, $mid, $s) = @$r;
+	set_art($self, $art);
 	more($self, "220 $n <$mid> article retrieved - head and body follow");
 	do_more($self, header_str($s));
 	do_more($self, "\r\n");
 	simple_body_write($self, $s);
 }
 
-sub cmd_head ($$) {
+sub cmd_head ($;$) {
 	my ($self, $art) = @_;
 	my $r = $self->art_lookup($art, 2);
 	return $r unless ref $r;
 	my ($n, $mid, $s) = @$r;
+	set_art($self, $art);
 	more($self, "221 $n <$mid> article retrieved - head follows");
 	do_more($self, header_str($s));
 	'.'
 }
 
-sub cmd_body ($$) {
+sub cmd_body ($;$) {
 	my ($self, $art) = @_;
 	my $r = $self->art_lookup($art, 0);
 	return $r unless ref $r;
 	my ($n, $mid, $s) = @$r;
+	set_art($self, $art);
 	more($self, "222 $n <$mid> article retrieved - body follows");
 	simple_body_write($self, $s);
 }
 
-sub cmd_stat ($$) {
+sub cmd_stat ($;$) {
 	my ($self, $art) = @_;
 	my $r = $self->art_lookup($art, 0);
 	return $r unless ref $r;
 	my ($n, $mid, undef) = @$r;
+	set_art($self, $art);
 	"223 $n <$mid> article retrieved - request text separately";
 }
 
-- 
EW

[PATCH 11/12] nntp: log to FDs given by the Nntpd module

[Eric Wong]

This will allow us to redirect stdout/stderr more easily
for logging.
---
 lib/PublicInbox/NNTP.pm | 29 ++++++++++++++++++-----------
 public-inbox-nntpd      |  2 ++
 2 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 01039ba..80adb65 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -61,7 +61,7 @@ sub process_line ($$) {
 	my $err = $@;
 	if ($err && !$self->{closed}) {
 		chomp($l = Dumper(\$l));
-		warning('error from: ', $l, ' ', $err);
+		err($self, "error from: $l $err");
 		$res = '503 program fault - command not performed';
 	}
 	return 0 unless defined $res;
@@ -502,13 +502,13 @@ sub long_response ($$$$) {
 			$self->{long_res} = undef;
 
 			if ($err) {
-				warning("$err during long response[$fd] - ".
-					sprintf('%0.6', now() - $t0));
+				err($self,
+				    "$err during long response[$fd] - %0.6f",
+					now() - $t0);
 			}
 			if ($self->{closed}) {
-				printf(STDERR
-				       " deferred[$fd] aborted - %0.6f\n",
-				       now() - $t0);
+				out($self, " deferred[$fd] aborted - %0.6f",
+				           now() - $t0);
 			} else {
 				$self->watch_read(1);
 			}
@@ -522,8 +522,7 @@ sub long_response ($$$$) {
 			$self->{long_res} = undef;
 			$self->watch_read(1);
 			res($self, '.');
-			printf(STDERR " deferred[$fd] done - %0.6f\n",
-				now() - $t0);
+			out($self, " deferred[$fd] done - %0.6f", now() - $t0);
 		}
 	};
 	$self->{long_res}->(); # kick off!
@@ -713,6 +712,16 @@ sub do_write ($$) {
 	$done;
 }
 
+sub err ($$;@) {
+	my ($self, $fmt, @args) = @_;
+	printf { $self->{nntpd}->{err} } $fmt."\n", @args;
+}
+
+sub out ($$;@) {
+	my ($self, $fmt, @args) = @_;
+	printf { $self->{nntpd}->{out} } $fmt."\n", @args;
+}
+
 use constant MSG_MORE => ($^O eq 'linux') ? 0x8000 : 0;
 
 sub do_more ($$) {
@@ -750,7 +759,7 @@ sub event_read {
 		$r = eval { $self->process_line($line) };
 		my $d = $self->{long_res} ?
 			' deferred['.fileno($self->{sock}).']' : '';
-		printf(STDERR "$line - %0.6f$d\n", now() - $t0);
+		out($self, "$line - %0.6f$d", now() - $t0);
 	}
 	return $self->close if $r < 0;
 	my $len = bytes::length($$buf);
@@ -758,6 +767,4 @@ sub event_read {
 	$self->push_back_read($buf) if ($len);
 }
 
-sub warning { print STDERR 'W: ', @_, "\n" }
-
 1;
diff --git a/public-inbox-nntpd b/public-inbox-nntpd
index 7fec840..0c221fa 100644
--- a/public-inbox-nntpd
+++ b/public-inbox-nntpd
@@ -44,6 +44,8 @@ sub new {
 	my ($class) = @_;
 	my $self = fields::new($class);
 	$self->{groups} = {};
+	$self->{err} = \*STDERR;
+	$self->{out} = \*STDOUT;
 	$self;
 }
 
-- 
EW

[PATCH 12/12] nntp: article lookups by Message-ID may cross newsgroups

[Eric Wong]

Lynx seems to rely on this behavior for "ARTICLE <message-id>"

Tested with Lynx Version 2.8.8dev.12 (22 Feb 2012) on Debian wheezy.
---
 lib/PublicInbox/NNTP.pm | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 80adb65..d513953 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -330,7 +330,7 @@ sub cmd_quit ($) {
 
 sub art_lookup ($$$) {
 	my ($self, $art, $set_headers) = @_;
-	my $ng = $self->{ng} or return '412 no newsgroup has been selected';
+	my $ng = $self->{ng};
 	my ($n, $mid);
 	my $err;
 	if (defined $art) {
@@ -339,10 +339,18 @@ sub art_lookup ($$$) {
 			$n = int($art);
 			goto find_mid;
 		} elsif ($art =~ /\A<([^>]+)>\z/) {
-			$err = '430 no such article found';
 			$mid = $1;
-			$n = $ng->mm->num_for($mid);
-			defined $mid or return $err;
+			$err = '430 no such article found';
+			$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;
 		} else {
 			return r501;
 		}
@@ -351,10 +359,11 @@ sub art_lookup ($$$) {
 		$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;
 	}
-
+found:
 	my $o = 'HEAD:' . mid2path($mid);
 	my $s = eval { Email::Simple->new($ng->gcf->cat_file($o)) };
 	return $err unless $s;
-- 
EW