$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 = {};
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");
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;
$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;
}
$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 {
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};
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
# 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: $!";
}
}
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;
}
lei_ok 'forget-mail-sync', $url;
lei_ok 'ls-mail-sync';
unlike($lei_out, qr!\Q$host_port\E!, 'sync info gone after forget');
+ my $uid_url = "$url/;UID=".$stats->{'uid.max'};
+ lei_ok 'import', $uid_url;
+ lei_ok 'inspect', $uid_url;
+ $lei_out =~ /([a-f0-9]{40,})/ or
+ xbail 'inspect missed blob with UID URL';
+ my $blob = $1;
+ lei_ok 'lcat', $uid_url;
+ like $lei_out, qr/^Subject: /sm,
+ 'lcat shows mail text with UID URL';
+ like $lei_out, qr/\bblob:$blob\b/, 'lcat showed blob';
+ my $orig = $lei_out;
+ lei_ok 'lcat', "blob:$blob";
+ is($lei_out, $orig, 'lcat understands blob:...');
+ ok(!lei('lcat', $url), "lcat doesn't work on IMAP URL w/o UID");
});
+
done_testing;