interimap: Enforce SQLite foreign key constraints.

Setting the 'foreign_keys' PRAGMA during a multi-statement transaction
(when SQLite is not in autocommit mode) is a no-op.

https://www.sqlite.org/pragma.html#pragma_foreign_keys
https://www.sqlite.org/foreignkeys.html#fk_enable

2 files changed, 9 insertions, 4 deletions

diff --git a/Changelog b/Changelog
index 0a31639..3d8cd72 100644
--- a/Changelog
+++ b/Changelog
@@ -38,6 +38,8 @@ interimap (0.5) upstream;
    'mailboxes' table.
  - interimap: don't try to delete \NoSelect mailboxes (it's an error per
    RFC 3501 sec. 6.3.4).
+ - interimap: SQLite were not enforcing foreign key constraints (setting
+   the 'foreign_keys' PRAGMA during a transaction is a documented no-op).
 
  -- Guilhem Moulin <guilhem@fripost.org>  Fri, 10 May 2019 00:58:14 +0200
 
diff --git a/interimap b/interimap
index 3e1979b..78f50fa 100755
--- a/interimap
+++ b/interimap
@@ -162,7 +162,6 @@ $SIG{TERM} = sub { cleanup(); exit 0; };
     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
     );
@@ -174,7 +173,8 @@ $SIG{TERM} = sub { cleanup(); exit 0; };
     # Try to lock the database before any network traffic so we can fail
     # early if the database is already locked.
     $DBH->do("PRAGMA locking_mode = EXCLUSIVE");
-    $DBH->do("PRAGMA foreign_keys = ON");
+    $DBH->{AutoCommit} = 1; # turned back off later
+    $DBH->do("PRAGMA foreign_keys = OFF"); # toggled later (no-op if not in autocommit mode)
 }
 
 sub msg($@) {
@@ -380,6 +380,7 @@ fail(undef, "Local and remote namespaces are neither both flat nor both hierarch
 
     if ($schema_version < $DATABASE_VERSION) {
         # schema creation or upgrade required
+        $DBH->begin_work();
         if ($schema_version == 0) {
             my $sth = $DBH->table_info(undef, undef, undef, "TABLE");
             unless (defined $sth->fetch()) {
@@ -401,7 +402,6 @@ fail(undef, "Local and remote namespaces are neither both flat nor both hierarch
                 if defined $IMAP->{local}->{delimiter} and defined $IMAP->{remote}->{delimiter}
                         # we failed earlier if only one of them was NIL
                         and $IMAP->{local}->{delimiter} ne $IMAP->{remote}->{delimiter};
-            $DBH->do("PRAGMA foreign_keys = OFF");
             $DBH->do("CREATE TABLE _tmp${DATABASE_VERSION}_mailboxes (". join(", ",
                 q{idx        INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT},
                 q{mailbox    BLOB COLLATE BINARY NOT NULL CHECK (mailbox != '') UNIQUE},
@@ -419,12 +419,15 @@ fail(undef, "Local and remote namespaces are neither both flat nor both hierarch
             }
             $DBH->do("DROP TABLE mailboxes");
             $DBH->do("ALTER TABLE _tmp${DATABASE_VERSION}_mailboxes RENAME TO mailboxes");
-            $DBH->do("PRAGMA foreign_keys = ON");
         }
+        fail("database", "Broken referential integrity!  Refusing to commit changes.")
+            if defined $DBH->selectrow_arrayref("PRAGMA foreign_key_check");
         SCHEMA_DONE:
         $DBH->do("PRAGMA user_version = $DATABASE_VERSION");
         $DBH->commit();
     }
+    $DBH->do("PRAGMA foreign_keys = ON"); # no-op if not in autocommit mode
+    $DBH->{AutoCommit} = 0; # always explicitly commit changes
 }