[PATCH 0/5] introduce SQLite message map

[PATCH 0/5] introduce SQLite message map

[Eric Wong]

This will make it easier for users to deal with truncated URLs
from copy-and-paste errors.

Eric Wong (5):
      msgmap: add message mapping via SQLite
      searchidx: hoist out rlog code
      searchidx: sync Msgmap database along with Xapian
      extmsg: wire up to use msgmap for prefixes
      INSTALL: document DBD::SQLite and DBI dependencies

 INSTALL                      |   4 +-
 lib/PublicInbox/ExtMsg.pm    |  29 +++++----
 lib/PublicInbox/Msgmap.pm    | 137 +++++++++++++++++++++++++++++++++++++++++++
 lib/PublicInbox/Search.pm    |   9 ---
 lib/PublicInbox/SearchIdx.pm | 129 ++++++++++++++++++++++++++++------------
 t/msgmap.t                   |  53 +++++++++++++++++
 6 files changed, 300 insertions(+), 61 deletions(-)

[PATCH 1/5] msgmap: add message mapping via SQLite

[Eric Wong]

This will allow us to maintain stable article numbers for an
NNTP server independently of Xapian.
---
 lib/PublicInbox/Msgmap.pm | 137 ++++++++++++++++++++++++++++++++++++++++++++++
 t/msgmap.t                |  53 ++++++++++++++++++
 2 files changed, 190 insertions(+)
 create mode 100644 lib/PublicInbox/Msgmap.pm
 create mode 100644 t/msgmap.t

diff --git a/lib/PublicInbox/Msgmap.pm b/lib/PublicInbox/Msgmap.pm
new file mode 100644
index 0000000..a1748af
--- /dev/null
+++ b/lib/PublicInbox/Msgmap.pm
@@ -0,0 +1,137 @@
+# Copyright (C) 2015 all contributors <meta@public-inbox.org>
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+# bidirectional Message-ID <-> Article Number mapping
+package PublicInbox::Msgmap;
+use strict;
+use warnings;
+use fields qw(dbh mid_insert mid_for num_for);
+use DBI;
+use DBD::SQLite;
+
+sub new {
+	my ($class, $git_dir, $writable) = @_;
+	my $d = "$git_dir/public-inbox";
+	if ($writable && !-d $d && !mkdir $d) {
+		my $err = $!;
+		-d $d or die "$d not created: $err";
+	}
+	my $f = "$d/msgmap.sqlite3";
+	my $dbh = DBI->connect("dbi:SQLite:dbname=$f",'','', {
+		AutoCommit => 1,
+		RaiseError => 1,
+		PrintError => 0,
+		sqlite_use_immediate_transaction => 1,
+	});
+	$dbh->do('PRAGMA case_sensitive_like = ON');
+
+	$writable and create_tables($dbh);
+	my $self = fields::new($class);
+	$self->{dbh} = $dbh;
+	$self;
+}
+
+# accessor
+sub last_commit {
+	my ($self, $commit) = @_;
+	my $dbh = $self->{dbh};
+	my $prev;
+	use constant {
+		key => 'last_commit',
+		meta_select => 'SELECT val FROM meta WHERE key = ? LIMIT 1',
+		meta_update => 'UPDATE meta SET val = ? WHERE key = ? LIMIT 1',
+		meta_insert => 'INSERT INTO meta (key,val) VALUES (?,?)',
+	};
+
+	defined $commit or
+		return $dbh->selectrow_array(meta_select, undef, key);
+
+	$dbh->begin_work;
+	eval {
+		$prev = $dbh->selectrow_array(meta_select, undef, key);
+
+		if (defined $prev) {
+			$dbh->do(meta_update, undef, $commit, key);
+		} else {
+			$dbh->do(meta_insert, undef, key, $commit);
+		}
+		$dbh->commit;
+	};
+	return $prev unless $@;
+
+	$dbh->rollback;
+	die $@;
+}
+
+sub mid_insert {
+	my ($self, $mid) = @_;
+	my $dbh = $self->{dbh};
+	use constant MID_INSERT => 'INSERT INTO msgmap (mid) VALUES (?)';
+	my $sth = $self->{mid_insert} ||= $dbh->prepare(MID_INSERT);
+	$sth->bind_param(1, $mid);
+	$sth->execute;
+	$dbh->last_insert_id(undef, undef, 'msgmap', 'num');
+}
+
+use constant MID_FOR => 'SELECT mid FROM msgmap WHERE num = ? LIMIT 1';
+sub mid_for {
+	my ($self, $num) = @_;
+	my $dbh = $self->{dbh};
+	my $sth = $self->{mid_for} ||= $dbh->prepare(MID_FOR);
+	$sth->bind_param(1, $num);
+	$sth->execute;
+	$sth->fetchrow_array;
+}
+
+sub num_for {
+	my ($self, $mid) = @_;
+	my $dbh = $self->{dbh};
+	use constant NUM_FOR => 'SELECT num FROM msgmap WHERE mid = ? LIMIT 1';
+	my $sth = $self->{num_for} ||= $dbh->prepare(NUM_FOR);
+	$sth->bind_param(1, $mid);
+	$sth->execute;
+	$sth->fetchrow_array;
+}
+
+sub mid_prefixes {
+	my ($self, $pfx, $limit) = @_;
+
+	die "No prefix given" unless (defined $pfx && $pfx ne '');
+	$pfx =~ s/([%_])/\\$1/g;
+	$pfx .= '%';
+
+	$limit ||= 100;
+	$limit += 0; # force to integer
+	$limit ||= 100;
+
+	$self->{dbh}->selectcol_arrayref('SELECT mid FROM msgmap ' .
+					 'WHERE mid LIKE ? ESCAPE ? ' .
+					 "ORDER BY num DESC LIMIT $limit",
+					 undef, $pfx, '\\');
+}
+
+sub mid_delete {
+	my ($self, $mid) = @_;
+	my $dbh = $self->{dbh};
+	use constant MID_DELETE => 'DELETE FROM msgmap WHERE mid = ?';
+	my $sth = $dbh->prepare(MID_DELETE);
+	$sth->bind_param(1, $mid);
+	$sth->execute;
+}
+
+sub create_tables {
+	my ($dbh) = @_;
+	my $e;
+
+	$e = eval { $dbh->selectrow_array('EXPLAIN SELECT * FROM msgmap;') };
+	defined $e or $dbh->do('CREATE TABLE msgmap (' .
+			'num INTEGER PRIMARY KEY AUTOINCREMENT, '.
+			'mid VARCHAR(1000) NOT NULL, ' .
+			'UNIQUE (mid) )');
+
+	$e = eval { $dbh->selectrow_array('EXPLAIN SELECT * FROM meta') };
+	defined $e or $dbh->do('CREATE TABLE meta (' .
+			'key VARCHAR(32) PRIMARY KEY, '.
+			'val VARCHAR(255) NOT NULL)');
+}
+
+1;
diff --git a/t/msgmap.t b/t/msgmap.t
new file mode 100644
index 0000000..a34fd71
--- /dev/null
+++ b/t/msgmap.t
@@ -0,0 +1,53 @@
+# Copyright (C) 2015 all contributors <meta@public-inbox.org>
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+use strict;
+use warnings;
+use Test::More;
+use File::Temp qw/tempdir/;
+
+use_ok 'PublicInbox::Msgmap';
+my $tmpdir = tempdir(CLEANUP => 1);
+my $d = PublicInbox::Msgmap->new($tmpdir, 1);
+
+my %mid2num;
+my %num2mid;
+my @mids = qw(a@b c@d e@f g@h aa@bb aa@cc);
+foreach my $mid (@mids) {
+	my $n = $d->mid_insert($mid);
+	ok($n, "mid $mid inserted");
+	$mid2num{$mid} = $n;
+	$num2mid{$n} = $mid;
+}
+
+$@ = undef;
+eval { $d->mid_insert('a@b') };
+ok($@, 'error raised when attempting duplicate message ID');
+
+foreach my $n (keys %num2mid) {
+	is($d->mid_for($n), $num2mid{$n}, "num:$n maps correctly");
+}
+foreach my $mid (@mids) {
+	is($d->num_for($mid), $mid2num{$mid}, "mid:$mid maps correctly");
+}
+
+is_deeply($d->mid_prefixes('a'), [qw(aa@cc aa@bb a@b)], "mid_prefixes match");
+is_deeply($d->mid_prefixes('A'), [], "mid_prefixes is case sensitive");
+
+is(undef, $d->last_commit, "last commit not set");
+my $lc = 'deadbeef' x 5;
+is(undef, $d->last_commit($lc), 'previous last commit (undef) returned');
+is($lc, $d->last_commit, 'last commit was set correctly');
+
+my $nc = 'deaddead' x 5;
+is($lc, $d->last_commit($nc), 'returned previously set commit');
+is($nc, $d->last_commit, 'new commit was set correctly');
+
+is($d->mid_delete('a@b'), 1, 'deleted a@b');
+is($d->mid_delete('a@b') + 0, 0, 'delete again returns zero');
+is(undef, $d->num_for('a@b'), 'num_for fails on deleted msg');
+$d = undef;
+
+# idempotent
+ok(PublicInbox::Msgmap->new($tmpdir, 1), 'idempotent DB creation');
+
+done_testing();
-- 
EW

[PATCH 2/5] searchidx: hoist out rlog code

[Eric Wong]

We'll be reusing this for loading msgmap.
---
 lib/PublicInbox/SearchIdx.pm | 55 +++++++++++++++++++++++---------------------
 1 file changed, 29 insertions(+), 26 deletions(-)

diff --git a/lib/PublicInbox/SearchIdx.pm b/lib/PublicInbox/SearchIdx.pm
index c61e161..44f6bc1 100644
--- a/lib/PublicInbox/SearchIdx.pm
+++ b/lib/PublicInbox/SearchIdx.pm
@@ -275,42 +275,45 @@ sub index_sync {
 	$self->with_umask(sub { $self->_index_sync($head) });
 }
 
-# indexes all unindexed messages
-sub _index_sync {
-	my ($self, $head) = @_;
-	require PublicInbox::GitCatFile;
-	my $db = $self->{xdb};
+sub rlog {
+	my ($self, $range, $add_cb, $del_cb) = @_;
 	my $hex = '[a-f0-9]';
 	my $h40 = $hex .'{40}';
 	my $addmsg = qr!^:000000 100644 \S+ ($h40) A\t${hex}{2}/${hex}{38}$!;
 	my $delmsg = qr!^:100644 000000 ($h40) \S+ D\t${hex}{2}/${hex}{38}$!;
+	my $git_dir = $self->{git_dir};
+	require PublicInbox::GitCatFile;
+	my $git = PublicInbox::GitCatFile->new($git_dir);
+	my @cmd = ('git', "--git-dir=$git_dir", "log",
+		    qw/--reverse --no-notes --no-color --raw -r --no-abbrev/,
+		    $range);
+	my $latest;
+	my $pid = open(my $log, '-|', @cmd) or
+		die('open` '.join(' ', @cmd) . " pipe failed: $!\n");
+	while (my $line = <$log>) {
+		if ($line =~ /$addmsg/o) {
+			$add_cb->($self, $git, $1);
+		} elsif ($line =~ /$delmsg/o) {
+			$del_cb->($self, $git, $1);
+		} elsif ($line =~ /^commit ($h40)/o) {
+			$latest = $1;
+		}
+	}
+	close $log;
+	$latest;
+}
+
+# indexes all unindexed messages
+sub _index_sync {
+	my ($self, $head) = @_;
+	my $db = $self->{xdb};
 	$head ||= 'HEAD';
 
 	$db->begin_transaction;
 	eval {
-		my $git = PublicInbox::GitCatFile->new($self->{git_dir});
-
 		my $latest = $db->get_metadata('last_commit');
 		my $range = $latest eq '' ? $head : "$latest..$head";
-		$latest = undef;
-
-		# get indexed messages
-		my @cmd = ('git', "--git-dir=$self->{git_dir}", "log",
-			    qw/--reverse --no-notes --no-color --raw -r
-			       --no-abbrev/, $range);
-		my $pid = open(my $log, '-|', @cmd) or
-			die('open` '.join(' ', @cmd) . " pipe failed: $!\n");
-
-		while (my $line = <$log>) {
-			if ($line =~ /$addmsg/o) {
-				$self->index_blob($git, $1);
-			} elsif ($line =~ /$delmsg/o) {
-				$self->unindex_blob($git, $1);
-			} elsif ($line =~ /^commit ($h40)/o) {
-				$latest = $1;
-			}
-		}
-		close $log;
+		$latest = $self->rlog($range, *index_blob, *unindex_blob);
 		$db->set_metadata('last_commit', $latest) if defined $latest;
 	};
 	if ($@) {
-- 
EW

[PATCH 3/5] searchidx: sync Msgmap database along with Xapian

[Eric Wong]

We can avoid duplicating work of extracting messages from git if we
tie this to Xapian.  Of course, this ties the two features together,
but it's probably reasonable to expect that anybody who wants to use
public-inbox to serve messages to front-end users will have both.
---
 lib/PublicInbox/SearchIdx.pm | 84 ++++++++++++++++++++++++++++++++++----------
 1 file changed, 66 insertions(+), 18 deletions(-)

diff --git a/lib/PublicInbox/SearchIdx.pm b/lib/PublicInbox/SearchIdx.pm
index 44f6bc1..351450c 100644
--- a/lib/PublicInbox/SearchIdx.pm
+++ b/lib/PublicInbox/SearchIdx.pm
@@ -247,18 +247,36 @@ sub link_message_to_parents {
 }
 
 sub index_blob {
-	my ($self, $git, $blob) = @_;
-	my $mime = do_cat_mail($git, $blob) or return;
-	eval { $self->add_message($mime) };
-	warn "W: index_blob $blob: $@\n" if $@;
+	my ($self, $git, $mime) = @_;
+	$self->add_message($mime);
 }
 
 sub unindex_blob {
-	my ($self, $git, $blob) = @_;
-	my $mime = do_cat_mail($git, $blob) or return;
-	my $mid = $mime->header('Message-ID');
-	eval { $self->remove_message($mid) } if defined $mid;
-	warn "W: unindex_blob $blob: $@\n" if $@;
+	my ($self, $git, $mime) = @_;
+	my $mid = mid_clean($mime->header('Message-ID'));
+	$self->remove_message($mid) if defined $mid;
+}
+
+sub index_mm {
+	my ($self, $git, $mime) = @_;
+	$self->{mm}->mid_insert(mid_clean($mime->header('Message-ID')));
+}
+
+sub unindex_mm {
+	my ($self, $git, $mime) = @_;
+	$self->{mm}->mid_delete(mid_clean($mime->header('Message-ID')));
+}
+
+sub index_both {
+	my ($self, $git, $mime) = @_;
+	index_blob($self, $git, $mime);
+	index_mm($self, $git, $mime);
+}
+
+sub unindex_both {
+	my ($self, $git, $mime) = @_;
+	unindex_blob($self, $git, $mime);
+	unindex_mm($self, $git, $mime);
 }
 
 sub do_cat_mail {
@@ -292,9 +310,11 @@ sub rlog {
 		die('open` '.join(' ', @cmd) . " pipe failed: $!\n");
 	while (my $line = <$log>) {
 		if ($line =~ /$addmsg/o) {
-			$add_cb->($self, $git, $1);
+			my $mime = do_cat_mail($git, $1) or next;
+			$add_cb->($self, $git, $mime);
 		} elsif ($line =~ /$delmsg/o) {
-			$del_cb->($self, $git, $1);
+			my $mime = do_cat_mail($git, $1) or next;
+			$del_cb->($self, $git, $mime);
 		} elsif ($line =~ /^commit ($h40)/o) {
 			$latest = $1;
 		}
@@ -308,17 +328,45 @@ sub _index_sync {
 	my ($self, $head) = @_;
 	my $db = $self->{xdb};
 	$head ||= 'HEAD';
+	my $mm = $self->{mm} = eval {
+		require PublicInbox::Msgmap;
+		PublicInbox::Msgmap->new($self->{git_dir}, 1);
+	};
 
 	$db->begin_transaction;
-	eval {
-		my $latest = $db->get_metadata('last_commit');
-		my $range = $latest eq '' ? $head : "$latest..$head";
-		$latest = $self->rlog($range, *index_blob, *unindex_blob);
-		$db->set_metadata('last_commit', $latest) if defined $latest;
-	};
+	my $lx = $db->get_metadata('last_commit');
+	my $range = $lx eq '' ? $head : "$lx..$head";
+	if ($mm) {
+		$mm->{dbh}->begin_work;
+		my $lm = $mm->last_commit || '';
+		if ($lm eq $lx) {
+			# Common case is the indexes are synced,
+			# we only need to run git-log once:
+			$lx = $self->rlog($range, *index_both, *unindex_both);
+			$mm->{dbh}->commit;
+			if (defined $lx) {
+				$db->set_metadata('last_commit', $lx);
+				$mm->last_commit($lx);
+			}
+		} else {
+			# dumb case, msgmap and xapian are out-of-sync
+			# do not care for performance:
+			my $r = $lm eq '' ? $head : "$lm..$head";
+			$lm = $self->rlog($r, *index_mm, *unindex_mm);
+			$mm->{dbh}->commit;
+			$mm->last_commit($lm) if defined $lm;
+
+			goto xapian_only;
+		}
+	} else {
+		# user didn't install DBD::SQLite and DBI
+xapian_only:
+		$lx = $self->rlog($range, *index_blob, *unindex_blob);
+		$db->set_metadata('last_commit', $lx) if defined $lx;
+	}
 	if ($@) {
-		warn "indexing failed: $@\n";
 		$db->cancel_transaction;
+		$mm->{dbh}->rollback if $mm;
 	} else {
 		$db->commit_transaction;
 	}
-- 
EW

[PATCH 4/5] extmsg: wire up to use msgmap for prefixes

[Eric Wong]

DBI + DBD::SQLite has much better handling of prefix lookups
than Xapian.  While we're at it, avoid linking blatantly wrong
Message-IDs to external services.
---
 lib/PublicInbox/ExtMsg.pm | 29 +++++++++++++++++------------
 lib/PublicInbox/Search.pm |  9 ---------
 2 files changed, 17 insertions(+), 21 deletions(-)

diff --git a/lib/PublicInbox/ExtMsg.pm b/lib/PublicInbox/ExtMsg.pm
index 77537c2..0cba49d 100644
--- a/lib/PublicInbox/ExtMsg.pm
+++ b/lib/PublicInbox/ExtMsg.pm
@@ -54,7 +54,7 @@ sub ext_msg {
 				# no point in trying the fork fallback if we
 				# know Xapian is up-to-date but missing the
 				# message in the current repo
-				push @pfx, { srch => $s, url => $url };
+				push @pfx, { git_dir => $git_dir, url => $url };
 				next;
 			}
 		}
@@ -87,17 +87,21 @@ sub ext_msg {
 	# fall back to partial MID matching
 	my $n_partial = 0;
 	my @partial;
-	if ($have_xap) {
+
+	eval { require PublicInbox::Msgmap };
+	my $have_mm = $@ ? 0 : 1;
+	if ($have_mm) {
 		my $cgi = $ctx->{cgi};
 		my $url = ref($cgi) eq 'CGI' ? $cgi->url(-base) . '/'
 					: $cgi->base->as_string;
 		$url .= $listname;
-		unshift @pfx, { srch => $ctx->{srch}, url => $url };
+		unshift @pfx, { git_dir => $ctx->{git_dir}, url => $url };
 		foreach my $pfx (@pfx) {
-			my $srch = delete $pfx->{srch} or next;
+			my $git_dir = delete $pfx->{git_dir} or next;
+			my $mm = eval { PublicInbox::Msgmap->new($git_dir) };
 
-			# FIXME we may need a proper prefix trie here...
-			if (my $res = $srch->mid_prefix($mid)) {
+			$mm or next;
+			if (my $res = $mm->mid_prefixes($mid)) {
 				$n_partial += scalar(@$res);
 				$pfx->{res} = $res;
 				push @partial, $pfx;
@@ -114,20 +118,21 @@ sub ext_msg {
 
 	if ($n_partial) {
 		$code = 300;
-		$s.= "\nPartial matches found:\n\n";
+		my $es = $n_partial == 1 ? '' : 'es';
+		$s.= "\n$n_partial partial match$es found:\n\n";
 		foreach my $pfx (@partial) {
 			my $u = $pfx->{url};
 			foreach my $m (@{$pfx->{res}}) {
-				$h = PublicInbox::Hval->new($m);
-				$href = $h->as_href;
-				$html = $h->as_html;
-				$s .= qq{<a\nhref="$u/$href/">$u/$html/</a>\n};
+				my $p = PublicInbox::Hval->new($m);
+				my $r = $p->as_href;
+				my $t = $p->as_html;
+				$s .= qq{<a\nhref="$u/$r/">$u/$t/</a>\n};
 			}
 		}
 	}
 
 	# Fall back to external repos if configured
-	if (@EXT_URL) {
+	if (@EXT_URL && index($mid, '@') >= 0) {
 		$code = 300;
 		$s .= "\nPerhaps try an external site:\n\n";
 		foreach my $u (@EXT_URL) {
diff --git a/lib/PublicInbox/Search.pm b/lib/PublicInbox/Search.pm
index 2b33b39..a588af4 100644
--- a/lib/PublicInbox/Search.pm
+++ b/lib/PublicInbox/Search.pm
@@ -269,13 +269,4 @@ sub enquire {
 	$self->{enquire} ||= Search::Xapian::Enquire->new($self->{xdb});
 }
 
-sub mid_prefix {
-	my ($self, $mpfx) = @_;
-	my $query = eval { $self->qp->parse_query("m:$mpfx", FLAG_PARTIAL) };
-	return if $@;
-	my $res = $self->do_enquire($query, { relevance => 1 });
-	return unless $res->{total};
-	[ map { $_->mid } @{$res->{msgs}} ];
-}
-
 1;
-- 
EW

[PATCH 5/5] INSTALL: document DBD::SQLite and DBI dependencies

[Eric Wong]

They're optional, but probably highly useful.
---
 INSTALL | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/INSTALL b/INSTALL
index 2a9bd34..0e7203d 100644
--- a/INSTALL
+++ b/INSTALL
@@ -41,12 +41,14 @@ Optional modules:
   - URI::Escape[1]             liburi-perl
   - Search::Xapian[3]          libsearch-xapian-perl
   - IO::Compress::Gzip[3]      libio-compress-perl
+  - DBI[3]                     libdbi-perl
+  - DBD::SQLite[3]             libdbd-sqlite3-perl
 
 [1] - Only required for serving/generating Atom and HTML pages.
 [2] - Keep in mind this will be split into a separate Debian package
       when CGI.pm is dropped from the Perl standard library.
       Plack/PSGI and mod_perl2 are both supported.
-[3] - Optional for HTML web interface
+[3] - Optional for HTML web interface and NNTP server
 
 Copyright
 ---------
-- 
EW