diff options
| -rw-r--r-- | lib/PublicInbox/LeiExportKw.pm | 41 | ||||
| -rw-r--r-- | xt/net_writer-imap.t | 30 |
2 files changed, 58 insertions, 13 deletions
diff --git a/lib/PublicInbox/LeiExportKw.pm b/lib/PublicInbox/LeiExportKw.pm index 5ad33959..82a4db04 100644 --- a/lib/PublicInbox/LeiExportKw.pm +++ b/lib/PublicInbox/LeiExportKw.pm @@ -84,6 +84,37 @@ sub input_path_url { $lms->lms_commit; } +sub match_imap_url ($$) { + my ($all, $url) = @_; # $all = [ $lms->folders ]; + require PublicInbox::URIimap; + my $cli = PublicInbox::URIimap->new($url)->canonical; + my ($s, $h, $mb) = ($cli->scheme, $cli->host, $cli->mailbox); + my @uri = map { PublicInbox::URIimap->new($_)->canonical } + grep(m!\A\Q$s\E://.*?\Q$h\E\b.*?/\Q$mb\E\b!, @$all); + my @match; + for my $x (@uri) { + next if $x->mailbox ne $cli->mailbox; + next if $x->host ne $cli->host; + next if $x->port != $cli->port; + my $x_uidval = $x->uidvalidity; + next if ($cli->uidvalidity // $x_uidval) != $x_uidval; + + # allow nothing in CLI to possibly match ";AUTH=ANONYMOUS" + if (defined($x->auth) && !defined($cli->auth) && + !defined($cli->user)) { + push @match, $x; + # or maybe user was forgotten on CLI: + } elsif (defined($x->user) && !defined($cli->user)) { + push @match, $x; + } elsif (($x->user//"\0") eq ($cli->user//"\0")) { + push @match, $x; + } + } + return $match[0] if scalar(@match) <= 1; + warn "E: `$url' is ambiguous:\n\t", join("\n\t", @match), "\n"; + undef; +} + sub lei_export_kw { my ($lei, @folders) = @_; my $sto = $lei->_lei_store or return $lei->fail(<<EOM); @@ -133,6 +164,16 @@ EOM my $d = 'maildir:'.$lei->rel2abs($_); push(@no, $_) unless $all{$d}; $_ = $d; + } elsif (m!\Aimaps?://!i) { + my $orig = $_; + if (my $canon = match_imap_url(\@all, $orig)) { + $lei->qerr(<<EOM); +# using `$canon' instead of `$orig' +EOM + $_ = $canon; + } else { + push @no, $orig; + } } else { push @no, $_; } diff --git a/xt/net_writer-imap.t b/xt/net_writer-imap.t index 0e6d4831..ec8f80d1 100644 --- a/xt/net_writer-imap.t +++ b/xt/net_writer-imap.t @@ -23,7 +23,8 @@ my $folder = "INBOX.$base-$host-".strftime('%Y%m%d%H%M%S', gmtime(time)). "-$$-".sprintf('%x', int(rand(0xffffffff))); my $nwr = PublicInbox::NetWriter->new; chop($imap_url) if substr($imap_url, -1) eq '/'; -my $folder_uri = PublicInbox::URIimap->new("$imap_url/$folder"); +my $folder_url = "$imap_url/$folder"; +my $folder_uri = PublicInbox::URIimap->new($folder_url); is($folder_uri->mailbox, $folder, 'folder correct') or BAIL_OUT "BUG: bad $$uri"; $nwr->add_url($$folder_uri); @@ -120,13 +121,13 @@ test_lei(sub { } $set_cred_helper->("$ENV{HOME}/.gitconfig", $cred_set) if $cred_set; - lei_ok qw(q f:qp@example.com -o), $$folder_uri; + lei_ok qw(q f:qp@example.com -o), $folder_url; $nwr->imap_each($folder_uri, $imap_slurp_all, my $res = []); is(scalar(@$res), 1, 'got one deduped result') or diag explain($res); is_deeply($res->[0]->[1], $plack_qp_eml, 'lei q wrote expected result'); - lei_ok qw(q f:matz -a -o), $$folder_uri; + lei_ok qw(q f:matz -a -o), $folder_url; $nwr->imap_each($folder_uri, $imap_slurp_all, my $aug = []); is(scalar(@$aug), 2, '2 results after augment') or diag explain($aug); my $exp = $res->[0]->[1]->as_string; @@ -136,13 +137,13 @@ test_lei(sub { is(scalar(grep { $_->[1]->as_string eq $exp } @$aug), 1, 'new result shown after augment'); - lei_ok qw(q s:thisbetternotgiveanyresult -o), $folder_uri->as_string; + lei_ok qw(q s:thisbetternotgiveanyresult -o), $folder_url; $nwr->imap_each($folder_uri, $imap_slurp_all, my $empty = []); is(scalar(@$empty), 0, 'no results w/o augment'); my $f = 't/utf8.eml'; # <testmessage@example.com> $exp = eml_load($f); - lei_ok qw(convert -F eml -o), $$folder_uri, $f; + lei_ok qw(convert -F eml -o), $folder_url, $f; my (@uid, @res); $nwr->imap_each($folder_uri, sub { my ($u, $uid, $kw, $eml) = @_; @@ -157,12 +158,15 @@ test_lei(sub { lei_ok qw(import -F eml), $f, \'import local copy w/o keywords'; - lei_ok 'ls-mail-sync'; diag $lei_out; - lei_ok 'import', $$folder_uri; # populate mail_sync.sqlite3 + lei_ok 'import', $folder_url; # populate mail_sync.sqlite3 lei_ok qw(tag +kw:seen +kw:answered +kw:flagged), $f; - lei_ok 'ls-mail-sync'; diag $lei_out; - chomp(my $uri_val = $lei_out); - lei_ok 'export-kw', $uri_val; + lei_ok 'ls-mail-sync'; + my @ls = split(/\n/, $lei_out); + is(scalar(@ls), 1, 'only one folder in ls-mail-sync') or xbail(\@ls); + for my $l (@ls) { + like($l, qr/;UIDVALIDITY=\d+\z/, 'UIDVALIDITY'); + } + lei_ok 'export-kw', $folder_url; $mic = $nwr->mic_for_folder($folder_uri); my $flags = $mic->flags($uid[0]); is_deeply([sort @$flags], [ qw(\\Answered \\Flagged \\Seen) ], @@ -177,7 +181,7 @@ test_lei(sub { is_deeply(\@res, [ [ ['seen'], $exp ] ], 'seen flag set') or diag explain(\@res); - lei_ok qw(q s:thisbetternotgiveanyresult -o), $folder_uri->as_string, + lei_ok qw(q s:thisbetternotgiveanyresult -o), $folder_url, \'clobber folder but import flag'; $nwr->imap_each($folder_uri, $imap_slurp_all, $empty = []); is_deeply($empty, [], 'clobbered folder'); @@ -206,7 +210,7 @@ EOM run_script(\@cmd) or BAIL_OUT "init wtest"; xsys(qw(git config), "--file=$ENV{HOME}/.public-inbox/config", 'publicinbox.wtest.watch', - $$folder_uri) == 0 or BAIL_OUT "git config $?"; + $folder_url) == 0 or BAIL_OUT "git config $?"; my $watcherr = "$ENV{HOME}/watch.err"; open my $err_wr, '>>', $watcherr or BAIL_OUT $!; my $pub_cfg = PublicInbox::Config->new; @@ -231,7 +235,7 @@ EOM ok(defined($mm->num_for('forwarded@test.example.com')), '-watch takes forwarded message'); undef $w; # done with watch - lei_ok qw(import), $$folder_uri; + lei_ok qw(import), $folder_url; lei_ok qw(q m:forwarded@test.example.com); is_deeply(json_utf8->decode($lei_out)->[0]->{kw}, ['forwarded'], 'forwarded kw imported from IMAP'); |