+sub _imap_fetch_all ($$$) {
+ my ($self, $mic, $orig_uri) = @_;
+ my $sec = uri_section($orig_uri);
+ my $mbx = $orig_uri->mailbox;
+ $mic->Clear(1); # trim results history
+
+ # we need to check for mailbox writability to see if we care about
+ # FLAGS from already-imported messages.
+ my $cmd = $self->{each_old} ? 'select' : 'examine';
+ $mic->$cmd($mbx) or return "E: \U$cmd\E $mbx ($sec) failed: $!";
+
+ my ($r_uidval, $r_uidnext, $perm_fl);
+ for ($mic->Results) {
+ /^\* OK \[PERMANENTFLAGS \(([^\)]*)\)\].*/ and $perm_fl = $1;
+ /^\* OK \[UIDVALIDITY ([0-9]+)\].*/ and $r_uidval = $1;
+ /^\* OK \[UIDNEXT ([0-9]+)\].*/ and $r_uidnext = $1;
+ }
+ $r_uidval //= $mic->uidvalidity($mbx) //
+ return "E: $orig_uri cannot get UIDVALIDITY";
+ $r_uidnext //= $mic->uidnext($mbx) //
+ return "E: $orig_uri cannot get UIDNEXT";
+ my $expect = $orig_uri->uidvalidity // $r_uidval;
+ return <<EOF if $expect != $r_uidval;
+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);
+ if (defined($single_uid)) {
+ $itrk = $l_uid = undef;
+ $uri->uid(undef); # for eml_cb
+ }
+ return <<EOF if $l_uidval != $r_uidval;
+E: $uri UIDVALIDITY mismatch
+E: local=$l_uidval != remote=$r_uidval
+EOF
+ $uri->uidvalidity($r_uidval);
+ $l_uid //= 0;
+ my $r_uid = $r_uidnext - 1;
+ return <<EOF if $l_uid > $r_uid;
+E: $uri local UID exceeds remote ($l_uid > $r_uid)
+E: $uri strangely, UIDVALIDLITY matches ($l_uidval)
+EOF
+ $mic->Uid(1); # the default, we hope
+ my $err;
+ if (!defined($single_uid) && $self->{each_old} &&
+ perm_fl_ok($perm_fl)) {
+ $err = each_old_flags($self, $mic, $uri, $l_uid);
+ return $err if $err;
+ }
+ return if $l_uid >= $r_uid; # nothing to do
+ $l_uid ||= 1;
+ my ($mod, $shard) = @{$self->{shard_info} // []};
+ unless ($self->{quiet}) {
+ my $m = $mod ? " [(UID % $mod) == $shard]" : '';
+ warn "# $uri fetching UID $l_uid:$r_uid$m\n";
+ }
+ my $bs = $self->{imap_opt}->{$sec}->{batch_size} // 1;
+ my $req = $mic->imap4rev1 ? 'BODY.PEEK[]' : 'RFC822.PEEK';
+ my $key = $req;
+ $key =~ s/\.PEEK//;
+ my ($uids, $batch);
+ do {
+ # 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
+ 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: $!";
+ }
+ return if scalar(@$uids) == 0;
+
+ # RFC 3501 doesn't seem to indicate order of UID SEARCH
+ # responses, so sort it ourselves. Order matters so
+ # IMAPTracker can store the newest UID.
+ @$uids = sort { $a <=> $b } @$uids;
+
+ # Did we actually get new messages?
+ return if $uids->[0] < $l_uid;
+
+ $l_uid = $uids->[-1] + 1; # for next search
+ my $last_uid;
+ my $n = $self->{max_batch};
+
+ @$uids = grep { ($_ % $mod) == $shard } @$uids if $mod;
+ while (scalar @$uids) {
+ my @batch = splice(@$uids, 0, $bs);
+ $batch = join(',', @batch);
+ local $0 = "UID:$batch $mbx $sec";
+ my $r = $mic->fetch_hash($batch, $req, 'FLAGS');
+ unless ($r) { # network error?
+ last if $!{EINTR} && $self->{quit};
+ $err = "E: $uri UID FETCH $batch error: $!";
+ last;
+ }
+ for my $uid (@batch) {
+ # messages get deleted, so holes appear
+ my $per_uid = delete $r->{$uid} // next;
+ my $raw = delete($per_uid->{$key}) // next;
+ _imap_do_msg($self, $uri, $uid, \$raw,
+ $per_uid->{FLAGS});
+ $last_uid = $uid;
+ last if $self->{quit};
+ }
+ last if $self->{quit};
+ }
+ run_commit_cb($self);
+ $itrk->update_last($r_uidval, $last_uid) if $itrk;
+ } until ($err || $self->{quit} || defined($single_uid));
+ $err;
+}
+
+# uses cached auth info prepared by mic_for
+sub mic_get {
+ my ($self, $uri) = @_;
+ my $sec = uri_section($uri);
+ # see if caller saved result of imap_common_init
+ my $cached = $self->{mics_cached};
+ if ($cached) {
+ my $mic = $cached->{$sec};
+ return $mic if $mic && $mic->IsConnected;
+ delete $cached->{$sec};
+ }
+ my $mic_arg = $self->{mic_arg}->{$sec} or
+ die "BUG: no Mail::IMAPClient->new arg for $sec";
+ if (defined(my $cb_name = $mic_arg->{Authcallback})) {
+ if (ref($cb_name) ne 'CODE') {
+ $mic_arg->{Authcallback} = $self->can($cb_name);
+ }
+ }
+ my $mic = mic_new($self, $mic_arg, $sec, $uri);
+ $cached //= {}; # invalid placeholder if no cache enabled
+ $mic && $mic->IsConnected ? ($cached->{$sec} = $mic) : undef;
+}
+
+sub imap_each {
+ my ($self, $url, $eml_cb, @args) = @_;
+ my $uri = ref($url) ? $url : PublicInbox::URIimap->new($url);
+ my $sec = uri_section($uri);
+ local $0 = $uri->mailbox." $sec";
+ my $mic = mic_get($self, $uri);
+ my $err;
+ if ($mic) {
+ local $self->{eml_each} = [ $eml_cb, @args ];
+ $err = _imap_fetch_all($self, $mic, $uri);
+ } else {
+ $err = "E: <$uri> not connected: $!";
+ }
+ die $err if $err && $self->{-can_die};
+ warn $err if $err;
+ $mic;
+}
+
+# may used cached auth info prepared by nn_for once
+sub nn_get {
+ my ($self, $uri) = @_;
+ my $sec = uri_section($uri);
+ # see if caller saved result of nntp_common_init
+ my $cached = $self->{nn_cached} // {};
+ my $nn;
+ $nn = delete($cached->{$sec}) and return $nn;
+ my $nn_arg = $self->{nn_arg}->{$sec} or
+ die "BUG: no Net::NNTP->new arg for $sec";
+ my $nntp_opt = $self->{nntp_opt}->{$sec};
+ $nn = nn_new($nn_arg, $nntp_opt, $uri) or return;
+ if (my $postconn = $nntp_opt->{-postconn}) {
+ for my $m_arg (@$postconn) {
+ my ($method, @args) = @$m_arg;
+ $nn->$method(@args) and next;
+ die "E: <$uri> $method failed\n";
+ return;
+ }
+ }
+ $nn;
+}
+
+sub _nntp_fetch_all ($$$) {
+ my ($self, $nn, $uri) = @_;
+ my ($group, $num_a, $num_b) = $uri->group;
+ my $sec = uri_section($uri);
+ my ($nr, $beg, $end) = $nn->group($group);
+ unless (defined($nr)) {
+ my $msg = ndump($nn->message);
+ return "E: GROUP $group <$sec> $msg";
+ }
+
+ # IMAPTracker is also used for tracking NNTP, UID == article number
+ # LIST.ACTIVE can get the equivalent of UIDVALIDITY, but that's
+ # expensive. So we assume newsgroups don't change:
+ my ($itrk, $l_art) = itrk_last($self, $uri);
+
+ # allow users to specify articles to refetch
+ # cf. https://tools.ietf.org/id/draft-gilman-news-url-01.txt
+ # nntp://example.com/inbox.foo/$num_a-$num_b
+ $beg = $num_a if defined($num_a) && $num_a < $beg;
+ $end = $num_b if defined($num_b) && $num_b < $end;
+ if (defined $l_art) {
+ return if $l_art >= $end; # nothing to do
+ $beg = $l_art + 1;
+ }
+ my ($err, $art, $last_art, $kw); # kw stays undef, no keywords in NNTP
+ unless ($self->{quiet}) {
+ warn "# $uri fetching ARTICLE $beg..$end\n";
+ }
+ my $n = $self->{max_batch};
+ for ($beg..$end) {
+ last if $self->{quit};
+ $art = $_;
+ if (--$n < 0) {
+ run_commit_cb($self);
+ $itrk->update_last(0, $last_art) if $itrk;
+ $n = $self->{max_batch};
+ }
+ my $raw = $nn->article($art);
+ unless (defined($raw)) {
+ my $msg = ndump($nn->message);
+ if ($nn->code == 421) { # pseudo response from Net::Cmd
+ $err = "E: $msg";
+ last;
+ } else { # probably just a deleted message (spam)
+ warn "W: $msg";
+ next;
+ }
+ }
+ $raw = join('', @$raw);
+ $raw =~ s/\r\n/\n/sg;
+ my ($eml_cb, @args) = @{$self->{eml_each}};
+ $eml_cb->($uri, $art, $kw, PublicInbox::Eml->new(\$raw), @args);
+ $last_art = $art;
+ }
+ run_commit_cb($self);
+ $itrk->update_last(0, $last_art) if $itrk;
+ $err;
+}
+
+sub nntp_each {
+ my ($self, $url, $eml_cb, @args) = @_;
+ my $uri = ref($url) ? $url : PublicInbox::URInntps->new($url);
+ my $sec = uri_section($uri);
+ local $0 = $uri->group ." $sec";
+ my $nn = nn_get($self, $uri);
+ return if $self->{quit};
+ my $err;
+ if ($nn) {
+ local $self->{eml_each} = [ $eml_cb, @args ];
+ $err = _nntp_fetch_all($self, $nn, $uri);
+ } else {
+ $err = "E: <$uri> not connected: $!";
+ }
+ die $err if $err && $self->{-can_die};
+ warn $err if $err;
+ $nn;
+}
+