diff options
Diffstat (limited to 'interimap')
| -rwxr-xr-x | interimap | 71 |
1 files changed, 39 insertions, 32 deletions
@@ -2,7 +2,7 @@ #---------------------------------------------------------------------- # Fast bidirectional synchronization for QRESYNC-capable IMAP servers -# Copyright © 2015,2016 Guilhem Moulin <guilhem@fripost.org> +# Copyright © 2015-2018 Guilhem Moulin <guilhem@fripost.org> # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -18,19 +18,21 @@ # along with this program. If not, see <http://www.gnu.org/licenses/>. #---------------------------------------------------------------------- +use v5.14.2; use strict; use warnings; -our $VERSION = '0.3'; +our $VERSION = '0.4'; my $NAME = 'interimap'; use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat bundling auto_version/; use DBI (); +use DBD::SQLite::Constants ':file_open'; use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/; use List::Util 'first'; use lib 'lib'; -use Net::IMAP::InterIMAP qw/read_config compact_set/; +use Net::IMAP::InterIMAP 0.0.4 qw/xdg_basedir read_config compact_set/; # Clean up PATH $ENV{PATH} = join ':', qw{/usr/bin /bin}; @@ -63,20 +65,24 @@ my $COMMAND = do { }; usage(1) if defined $COMMAND and (($COMMAND eq 'delete' and !@ARGV) or ($COMMAND eq 'rename' and $#ARGV != 1)); usage(1) if defined $COMMAND and (defined $CONFIG{watch} or defined $CONFIG{notify}); -usage(1) if $CONFIG{target} and !(defined $COMMAND and ($COMMAND eq 'delete'or $COMMAND eq 'rename')); +usage(1) if $CONFIG{target} and !(defined $COMMAND and ($COMMAND eq 'delete' or $COMMAND eq 'rename')); $CONFIG{watch} = $CONFIG{notify} ? 900 : 60 if (defined $CONFIG{watch} or $CONFIG{notify}) and !$CONFIG{watch}; @ARGV = map {uc $_ eq 'INBOX' ? 'INBOX' : $_ } @ARGV; # INBOX is case-insensitive die "Invalid mailbox name $_" foreach grep !/\A([\x01-\x7F]+)\z/, @ARGV; -my $CONF = read_config( delete $CONFIG{config} // $NAME - , [qw/_ local remote/] - , database => qr/\A(\P{Control}+)\z/ - , logfile => qr/\A(\/\P{Control}+)\z/ - , 'list-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ - , 'list-select-opts' => qr/\A([\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]+)\z/ - , 'ignore-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ - ); +my $CONF = do { + my $conffile = delete($CONFIG{config}) // "config"; + $conffile = xdg_basedir( XDG_CONFIG_HOME => ".config", $NAME, $conffile ); + read_config( $conffile + , [qw/_ local remote/] + , database => qr/\A(\P{Control}+)\z/ + , logfile => qr/\A(\/\P{Control}+)\z/ + , 'list-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ + , 'list-select-opts' => qr/\A([\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]+)\z/ + , 'ignore-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ + ); +}; my ($DBFILE, $LOGGER_FD); { @@ -84,16 +90,7 @@ my ($DBFILE, $LOGGER_FD); $DBFILE //= $CONF->{remote}->{host}.'.db' if defined $CONF->{remote}; $DBFILE //= $CONF->{local}->{host}. '.db' if defined $CONF->{local}; die "Missing option database" unless defined $DBFILE; - - unless ($DBFILE =~ /\A\//) { - my $dir = ($ENV{XDG_DATA_HOME} // "$ENV{HOME}/.local/share") .'/'. $NAME; - $dir =~ /\A(\/\p{Print}+)\z/ or die "Insecure $dir"; - $dir = $1; - $DBFILE = $dir .'/'. $DBFILE; - unless (-d $dir) { - mkdir $dir, 0700 or die "Can't mkdir $dir: $!\n"; - } - } + $DBFILE = xdg_basedir( XDG_DATA_HOME => ".local/share", $NAME, $DBFILE ); if (defined $CONF->{_} and defined $CONF->{_}->{logfile}) { require 'POSIX.pm'; @@ -125,18 +122,24 @@ $SIG{TERM} = sub { cleanup(); exit 0; }; ############################################################################# # Open the database and create tables -$DBH = DBI::->connect("dbi:SQLite:dbname=$DBFILE", undef, undef, { - AutoCommit => 0, - RaiseError => 1, - sqlite_see_if_its_a_number => 1, # see if the bind values are numbers or not - sqlite_use_immediate_transaction => 1, -}); -$DBH->sqlite_busy_timeout(250); -$DBH->do('PRAGMA locking_mode = EXCLUSIVE'); -$DBH->do('PRAGMA foreign_keys = ON'); - { + my $dbi_data_source = "dbi:SQLite:dbname=".$DBFILE; + my %dbi_attrs = ( + AutoCommit => 0, + RaiseError => 1, + sqlite_see_if_its_a_number => 1, # see if the bind values are numbers or not + sqlite_use_immediate_transaction => 1, + sqlite_open_flags => SQLITE_OPEN_READWRITE + ); + # don't auto-create in long-lived mode + $dbi_attrs{sqlite_open_flags} |= SQLITE_OPEN_CREATE unless defined $CONFIG{watch}; + + $DBH = DBI::->connect($dbi_data_source, undef, undef, \%dbi_attrs); + $DBH->sqlite_busy_timeout(250); + $DBH->do('PRAGMA locking_mode = EXCLUSIVE'); + $DBH->do('PRAGMA foreign_keys = ON'); + my @schema = ( mailboxes => [ q{idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT}, @@ -166,6 +169,10 @@ $DBH->do('PRAGMA foreign_keys = ON'); # also, lUID < local.UIDNEXT and rUID < remote.UIDNEXT (except for interrupted syncs) # mapping.idx must be found among local.idx (and remote.idx) ], + + # We have no version number in the schema, but if we ever need a + # migration, we'll add a new table, and assume version 1.0 if + # the table is missing. ); # Invariants: |