X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FLeiMailSync.pm;h=75603d89e1788127487e83a5b396b882d60ba8c1;hb=bdecd7ed8e0dcf0b45491b947cd737ba8cfe38a3;hp=52f26d69107374878ac286fdafc5578bd0fc8505;hpb=7dd4d590e1d5e12b2b767122aeec66124a10acb1;p=public-inbox.git diff --git a/lib/PublicInbox/LeiMailSync.pm b/lib/PublicInbox/LeiMailSync.pm index 52f26d69..75603d89 100644 --- a/lib/PublicInbox/LeiMailSync.pm +++ b/lib/PublicInbox/LeiMailSync.pm @@ -6,17 +6,13 @@ package PublicInbox::LeiMailSync; use strict; use v5.10.1; use DBI; +use PublicInbox::ContentHash qw(git_sha); +use Carp (); sub dbh_new { my ($self, $rw) = @_; my $f = $self->{filename}; - my $creat; - if (!-f $f && $rw) { - require PublicInbox::Spawn; - open my $fh, '+>>', $f or die "failed to open $f: $!"; - PublicInbox::Spawn::nodatacow_fd(fileno($fh)); - $creat = 1; - } + my $creat = $rw && !-s $f; my $dbh = DBI->connect("dbi:SQLite:dbname=$f",'','', { AutoCommit => 1, RaiseError => 1, @@ -58,6 +54,10 @@ CREATE TABLE IF NOT EXISTS blob2num ( UNIQUE (oidbin, fid, uid) ) + # speeds up LeiImport->ck_update_kw (for "lei import") by 5-6x: + $dbh->do(<<''); +CREATE INDEX IF NOT EXISTS idx_fid_uid ON blob2num(fid,uid) + $dbh->do(<<''); CREATE TABLE IF NOT EXISTS blob2name ( oidbin VARBINARY NOT NULL, @@ -68,18 +68,41 @@ CREATE TABLE IF NOT EXISTS blob2name ( } -sub _fid_for { +sub fid_for { my ($self, $folder, $rw) = @_; - my $dbh = $self->{dbh}; - my ($row) = $dbh->selectrow_array(<<'', undef, $folder); -SELECT fid FROM folders WHERE loc = ? LIMIT 1 + my $dbh = $self->{dbh} //= dbh_new($self, $rw); + my $sel = 'SELECT fid FROM folders WHERE loc = ? LIMIT 1'; + my ($fid) = $dbh->selectrow_array($sel, undef, $folder); + return $fid if defined $fid; - return $row if defined $row; + if ($folder =~ s!\A((?:maildir|mh):.*?)/+\z!$1!i) { + warn "folder: $folder/ had trailing slash in arg\n"; + ($fid) = $dbh->selectrow_array($sel, undef, $folder); + if (defined $fid) { + $dbh->do(<selectrow_array($sel, undef, "$folder/"); + if (defined $fid) { + $dbh->do(<new($folder)->uidvalidity // + Carp::croak("BUG: $folder has no UIDVALIDITY"); + } return unless $rw; - ($row) = $dbh->selectrow_array('SELECT MAX(fid) FROM folders'); + ($fid) = $dbh->selectrow_array('SELECT MAX(fid) FROM folders'); - my $fid = ($row // 0) + 1; + $fid += 1; # in case we're reusing, clobber existing stale refs: $dbh->do('DELETE FROM blob2name WHERE fid = ?', undef, $fid); $dbh->do('DELETE FROM blob2num WHERE fid = ?', undef, $fid); @@ -92,7 +115,7 @@ SELECT fid FROM folders WHERE loc = ? LIMIT 1 sub set_src { my ($self, $oidhex, $folder, $id) = @_; - my $fid = $self->{fmap}->{$folder} //= _fid_for($self, $folder, 1); + my $fid = $self->{fmap}->{$folder} //= fid_for($self, $folder, 1); my $sth; if (ref($id)) { # scalar name $id = $$id; @@ -109,7 +132,7 @@ INSERT OR IGNORE INTO blob2num (oidbin, fid, uid) VALUES (?, ?, ?) sub clear_src { my ($self, $folder, $id) = @_; - my $fid = $self->{fmap}->{$folder} //= _fid_for($self, $folder, 1); + my $fid = $self->{fmap}->{$folder} //= fid_for($self, $folder, 1); my $sth; if (ref($id)) { # scalar name $id = $$id; @@ -124,12 +147,27 @@ DELETE FROM blob2num WHERE fid = ? AND uid = ? $sth->execute($fid, $id); } +# Maildir-only +sub mv_src { + my ($self, $folder, $oidbin, $id, $newbn) = @_; + my $fid = $self->{fmap}->{$folder} //= fid_for($self, $folder, 1); + my $sth = $self->{dbh}->prepare_cached(<<''); +UPDATE blob2name SET name = ? WHERE fid = ? AND oidbin = ? AND name = ? + + $sth->execute($newbn, $fid, $oidbin, $$id); +} + # read-only, iterates every oidbin + UID or name for a given folder sub each_src { my ($self, $folder, $cb, @args) = @_; my $dbh = $self->{dbh} //= dbh_new($self); my ($fid, $sth); - $fid = $self->{fmap}->{$folder} //= _fid_for($self, $folder) // return; + if (ref($folder) eq 'HASH') { + $fid = $folder->{fid} // die "BUG: no `fid'"; + } else { + $fid = $self->{fmap}->{$folder} //= + fid_for($self, $folder) // return; + } $sth = $dbh->prepare('SELECT oidbin,uid FROM blob2num WHERE fid = ?'); $sth->execute($fid); while (my ($oidbin, $id) = $sth->fetchrow_array) { @@ -143,11 +181,11 @@ sub each_src { } sub location_stats { - my ($self, $folder, $cb, @args) = @_; + my ($self, $folder) = @_; my $dbh = $self->{dbh} //= dbh_new($self); my $fid; my $ret = {}; - $fid = $self->{fmap}->{$folder} //= _fid_for($self, $folder) // return; + $fid = $self->{fmap}->{$folder} //= fid_for($self, $folder) // return; my ($row) = $dbh->selectrow_array(<<"", undef, $fid); SELECT COUNT(name) FROM blob2name WHERE fid = ? @@ -208,4 +246,160 @@ sub folders { map { $_->[0] } @{$dbh->selectall_arrayref($sql, undef, @pfx)}; } +sub local_blob { + my ($self, $oidhex, $vrfy) = @_; + my $dbh = $self->{dbh} //= dbh_new($self); + my $b2n = $dbh->prepare(<<''); +SELECT f.loc,b.name FROM blob2name b +LEFT JOIN folders f ON b.fid = f.fid +WHERE b.oidbin = ? + + $b2n->execute(pack('H*', $oidhex)); + while (my ($d, $n) = $b2n->fetchrow_array) { + substr($d, 0, length('maildir:')) = ''; + # n.b. both mbsync and offlineimap use ":2," as a suffix + # in "new/", despite (from what I understand of reading + # ), the ":2," only + # applies to files in "cur/". + my @try = $n =~ /:2,[a-zA-Z]+\z/ ? qw(cur new) : qw(new cur); + for my $x (@try) { + my $f = "$d/$x/$n"; + open my $fh, '<', $f or next; + # some (buggy) Maildir writers are non-atomic: + next unless -s $fh; + local $/; + my $raw = <$fh>; + if ($vrfy && git_sha(1, \$raw)->hexdigest ne $oidhex) { + warn "$f changed $oidhex\n"; + next; + } + return \$raw; + } + } + undef; +} + +sub match_imap_url { + my ($self, $url, $all) = @_; # $all = [ $lms->folders ]; + $all //= [ $self->folders ]; + require PublicInbox::URIimap; + my $want = PublicInbox::URIimap->new($url)->canonical; + my ($s, $h, $mb) = ($want->scheme, $want->host, $want->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 $want->mailbox; + next if $x->host ne $want->host; + next if $x->port != $want->port; + my $x_uidval = $x->uidvalidity; + next if ($want->uidvalidity // $x_uidval) != $x_uidval; + + # allow nothing in want to possibly match ";AUTH=ANONYMOUS" + if (defined($x->auth) && !defined($want->auth) && + !defined($want->user)) { + push @match, $x; + # or maybe user was forgotten on CLI: + } elsif (defined($x->user) && !defined($want->user)) { + push @match, $x; + } elsif (($x->user//"\0") eq ($want->user//"\0")) { + push @match, $x; + } + } + return @match if wantarray; + scalar(@match) <= 1 ? $match[0] : + "E: `$url' is ambiguous:\n\t".join("\n\t", @match)."\n"; +} + +# map CLI args to folder table entries, returns undef on failure +sub arg2folder { + my ($self, $lei, $folders) = @_; + my @all = $self->folders; + my %all = map { $_ => 1 } @all; + my ($err, @no); + for (@$folders) { + next if $all{$_}; # ok + if (m!\A(maildir|mh):(.+)!i) { + my $type = lc $1; + my $d = "$type:".$lei->abs_path($2); + push(@no, $_) unless $all{$d}; + $_ = $d; + } elsif (-d "$_/new" && -d "$_/cur") { + my $d = 'maildir:'.$lei->abs_path($_); + push(@no, $_) unless $all{$d}; + $_ = $d; + } elsif (m!\Aimaps?://!i) { + my $orig = $_; + my $res = match_imap_url($self, $orig, \@all); + if (ref $res) { + $_ = $$res; + push(@{$err->{qerr}}, <err($res) if defined $res; + push @no, $orig; + } + } else { + push @no, $_; + } + } + if (@no) { + my $no = join("\n\t", @no); + $err->{fail} = <{fmap}->{$folder}) // + fid_for($self, $folder) // return; + my $dbh = $self->{dbh}; + $dbh->do('DELETE FROM blob2name WHERE fid = ?', undef, $fid); + $dbh->do('DELETE FROM blob2num WHERE fid = ?', undef, $fid); + $dbh->do('DELETE FROM folders WHERE fid = ?', undef, $fid); +} + +sub imap_oidbin ($$$) { + my ($self, $url, $uid) = @_; # $url MUST have UIDVALIDITY + my $fid = $self->{fmap}->{$url} //= fid_for($self, $url) // return; + my $sth = $self->{dbh}->prepare_cached(<execute($fid, $uid); + $sth->fetchrow_array; +} + +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 $oidbin = imap_oidbin($self, $folders->[0], $uid_uri->uid); + $oidbin ? unpack('H*', $oidbin) : undef; +} + +# FIXME: something with "lei " is causing uncommitted transaction +# warnings, not sure what... +sub DESTROY { + my ($self) = @_; + my $dbh = delete($self->{dbh}) or return; + return if $dbh->{ReadOnly}; + use Carp; + undef $dbh; + warn "BUG $$ $0 $self {dbh} OPEN ppid=".getppid.' '.Carp::longmess(); +} + 1;