lei: handle a single IMAP message in most places

"lei import" can now import a single IMAP message via
<imaps://example.com/MAILBOX/;UID=$UID>

Likewise, "lei inspect" can show the blob information for UID
URLs and "lei lcat" can display the blob without network access
if imported.

"lei lcat" also gets rid of some unused code and supports
"blob:$OIDHEX" syntax as described in the comments (and used by
our "text" output format).

v2: enforce UID in URL, fail without
v3: fix error reporting (s/fail/child_error/)

5 files changed, 78 insertions, 18 deletions

diff --git a/lib/PublicInbox/LeiInspect.pm b/lib/PublicInbox/LeiInspect.pm
index 46b9197f..7205979e 100644
--- a/lib/PublicInbox/LeiInspect.pm
+++ b/lib/PublicInbox/LeiInspect.pm
@@ -24,6 +24,19 @@ sub inspect_blob ($$) {
         $ent;
 }
 
+sub inspect_imap_uid ($$) {
+        my ($lei, $uid_uri) = @_;
+        my $ent = {};
+        my $lse = $lei->{lse} or return $ent;
+        my $lms = $lse->lms or return $ent;
+        my $oidhex = $lms->imap_oid($lei, $uid_uri);
+        if (ref(my $err = $oidhex)) { # art2folder error
+                $lei->qerr(@{$err->{qerr}}) if $err->{qerr};
+        }
+        $ent->{$$uid_uri} = $oidhex;
+        $ent;
+}
+
 sub inspect_sync_folder ($$) {
         my ($lei, $folder) = @_;
         my $ent = {};
@@ -49,8 +62,15 @@ sub inspect1 ($$$) {
         my $ent;
         if ($item =~ /\Ablob:(.+)/) {
                 $ent = inspect_blob($lei, $1);
-        } elsif ($item =~ m!\Aimaps?://!i ||
-                        $item =~ m!\A(?:maildir|mh):!i || -d $item) {
+        } elsif ($item =~ m!\Aimaps?://!i) {
+                require PublicInbox::URIimap;
+                my $uri = PublicInbox::URIimap->new($item);
+                if (defined($uri->uid)) {
+                        $ent = inspect_imap_uid($lei, $uri);
+                } else {
+                        $ent = inspect_sync_folder($lei, $item);
+                }
+        } elsif ($item =~ m!\A(?:maildir|mh):!i || -d $item) {
                 $ent = inspect_sync_folder($lei, $item);
         } else { # TODO: more things
                 return $lei->fail("$item not understood");
diff --git a/lib/PublicInbox/LeiLcat.pm b/lib/PublicInbox/LeiLcat.pm
index 87729acf..0f585ff5 100644
--- a/lib/PublicInbox/LeiLcat.pm
+++ b/lib/PublicInbox/LeiLcat.pm
@@ -9,27 +9,31 @@ use strict;
 use v5.10.1;
 use PublicInbox::LeiViewText;
 use URI::Escape qw(uri_unescape);
-use URI;
 use PublicInbox::MID qw($MID_EXTRACT);
 
-sub lcat_redispatch {
-        my ($lei, $out, $op_p) = @_;
-        my $l = bless { %$lei }, ref($lei);
-        delete $l->{sock};
-        $l->{''} = $op_p; # daemon only
-        eval {
-                $l->qerr("# updating $out");
-                up1($l, $out);
-                $l->qerr("# $out done");
-        };
-        $l->err($@) if $@;
+sub lcat_imap_uid_uri ($$) {
+        my ($lei, $uid_uri) = @_;
+        my $lms = $lei->{lse}->lms or return;
+        my $oidhex = $lms->imap_oid($lei, $uid_uri);
+        if (ref(my $err = $oidhex)) { # art2folder error
+                $lei->qerr(@{$err->{qerr}}) if $err->{qerr};
+        }
+        push @{$lei->{lcat_blob}}, $oidhex; # cf. LeiToMail->wq_atexit_child
 }
 
 sub extract_1 ($$) {
         my ($lei, $x) = @_;
-        if ($x =~ m!\b([a-z]+?://\S+)!i) {
+        if ($x =~ m!\b(imaps?://[^>]+)!i) {
+                my $u = $1;
+                require PublicInbox::URIimap;
+                $u = PublicInbox::URIimap->new($u);
+                defined($u->uid) ? lcat_imap_uid_uri($lei, $u) :
+                                $lei->child_error(1 << 8, "# no UID= in $u");
+                '""'; # blank query, using {lcat_blob}
+        } elsif ($x =~ m!\b([a-z]+?://\S+)!i) {
                 my $u = $1;
                 $u =~ s/[\>\]\)\,\.\;]+\z//;
+                require URI;
                 $u = URI->new($u);
                 my $p = $u->path;
                 my $term;
@@ -57,6 +61,9 @@ sub extract_1 ($$) {
                 $1;
         } elsif ($x =~ /\bid:(\S+)/) { # notmuch convention
                 "mid:$1";
+        } elsif ($x =~ /\bblob:([0-9a-f]{7,})\b/) {
+                push @{$lei->{lcat_blob}}, $1; # cf. LeiToMail->wq_atexit_child
+                '""'; # blank query
         } else {
                 undef;
         }
diff --git a/lib/PublicInbox/LeiMailSync.pm b/lib/PublicInbox/LeiMailSync.pm
index 6120d59f..5c0988b5 100644
--- a/lib/PublicInbox/LeiMailSync.pm
+++ b/lib/PublicInbox/LeiMailSync.pm
@@ -356,6 +356,28 @@ sub forget_folder {
         $dbh->do('DELETE FROM folders WHERE fid = ?', undef, $fid);
 }
 
+sub imap_oid {
+        my ($self, $lei, $uid_uri) = @_;
+        my $mailbox_uri = $uid_uri->clone;
+        $mailbox_uri->uid(undef);
+        my $folders = [ $$mailbox_uri ];
+        if (my $err = $self->arg2folder($lei, $folders)) {
+                if ($err->{fail}) {
+                        $lei->qerr("# no sync information for $mailbox_uri");
+                        return;
+                }
+                $lei->qerr(@{$err->{qerr}}) if $err->{qerr};
+        }
+        my $fid = $self->{fmap}->{$folders->[0]} //=
+                _fid_for($self, $folders->[0]) // return;
+        my $sth = $self->{dbh}->prepare_cached(<<EOM, undef, 1);
+SELECT oidbin FROM blob2num WHERE fid = ? AND uid = ?
+EOM
+        $sth->execute($fid, $uid_uri->uid);
+        my ($oidbin) = $sth->fetchrow_array;
+        $oidbin ? unpack('H*', $oidbin) : undef;
+}
+
 # FIXME: something with "lei <up|q>" is causing uncommitted transaction
 # warnings, not sure what...
 sub DESTROY {
diff --git a/lib/PublicInbox/LeiToMail.pm b/lib/PublicInbox/LeiToMail.pm
index ad6b9439..b3aec50b 100644
--- a/lib/PublicInbox/LeiToMail.pm
+++ b/lib/PublicInbox/LeiToMail.pm
@@ -702,8 +702,14 @@ sub write_mail { # via ->wq_io_do
 
 sub wq_atexit_child {
         my ($self) = @_;
-        delete $self->{wcb};
         my $lei = $self->{lei};
+        if (!$self->{-wq_worker_nr} && $lei->{lcat_blob}) {
+                for my $oid (@{$lei->{lcat_blob}}) {
+                        my $smsg = { blob => $oid, pct => 100 };
+                        write_mail($self, $smsg);
+                }
+        }
+        delete $self->{wcb};
         $lei->{ale}->git->async_wait_all;
         my $nr = delete($lei->{-nr_write}) or return;
         return if $lei->{early_mua} || !$lei->{-progress} || !$lei->{pkt_op_p};
diff --git a/lib/PublicInbox/NetReader.pm b/lib/PublicInbox/NetReader.pm
index 73b8b1cd..76d2fe62 100644
--- a/lib/PublicInbox/NetReader.pm
+++ b/lib/PublicInbox/NetReader.pm
@@ -469,7 +469,10 @@ E: $orig_uri UIDVALIDITY mismatch (got $r_uidval)
 EOF
 
         my $uri = $orig_uri->clone;
+        my $single_uid = $uri->uid;
         my ($itrk, $l_uid, $l_uidval) = itrk_last($self, $uri, $r_uidval, $mic);
+        $itrk = $l_uid = undef if defined($single_uid);
+
         return <<EOF if $l_uidval != $r_uidval;
 E: $uri UIDVALIDITY mismatch
 E: local=$l_uidval != remote=$r_uidval
@@ -499,7 +502,9 @@ EOF
                 # I wish "UID FETCH $START:*" could work, but:
                 # 1) servers do not need to return results in any order
                 # 2) Mail::IMAPClient doesn't offer a streaming API
-                unless ($uids = $mic->search("UID $l_uid:*")) {
+                if (defined $single_uid) {
+                        $uids = [ $single_uid ];
+                } elsif (!($uids = $mic->search("UID $l_uid:*"))) {
                         return if $!{EINTR} && $self->{quit};
                         return "E: $uri UID SEARCH $l_uid:* error: $!";
                 }
@@ -541,7 +546,7 @@ EOF
                 }
                 run_commit_cb($self);
                 $itrk->update_last($r_uidval, $last_uid) if $itrk;
-        } until ($err || $self->{quit});
+        } until ($err || $self->{quit} || defined($single_uid));
         $err;
 }