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,
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,
}
-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(<<EOM, undef, $folder, $fid) if $rw;
+UPDATE folders SET loc = ? WHERE fid = ?
+EOM
+ return $fid;
+ }
+ # sometimes we stored trailing slash..
+ } elsif ($folder =~ m!\A(?:maildir|mh):!i) {
+ ($fid) = $dbh->selectrow_array($sel, undef, "$folder/");
+ if (defined $fid) {
+ $dbh->do(<<EOM, undef, $folder, $fid) if $rw;
+UPDATE folders SET loc = ? WHERE fid = ?
+EOM
+ return $fid;
+ }
+ } elsif ($rw && $folder =~ m!\Aimaps?://!i) {
+ require PublicInbox::URIimap;
+ PublicInbox::URIimap->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);
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;
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;
$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) {
}
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 = ?
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
+ # <https://cr.yp.to/proto/maildir.html>), 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}}, <<EOM);
+# using `$res' instead of `$orig'
+EOM
+ } else {
+ $lei->err($res) if defined $res;
+ push @no, $orig;
+ }
+ } else {
+ push @no, $_;
+ }
+ }
+ if (@no) {
+ my $no = join("\n\t", @no);
+ $err->{fail} = <<EOF;
+No sync information for: $no
+Run `lei ls-mail-sync' to display valid choices
+EOF
+ }
+ $err;
+}
+
+sub forget_folder {
+ my ($self, $folder) = @_;
+ my ($fid, $sth);
+ $fid = delete($self->{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(<<EOM, undef, 1);
+SELECT oidbin FROM blob2num WHERE fid = ? AND uid = ?
+EOM
+ $sth->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 <up|q>" 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;