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

diff --git a/Changelog b/Changelog
index 0a316392dca0cbb589f0addc3f1d04868b8da5d2..3d8cd72a916d0b6f3525be8f0344be5274b44c10 100644 (file)
--- 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 3e1979bed34d7e45fc55c44e3d05d27b51ec3751..78f50fa046e4160d969cd061048df7624e2219e9 100755 (executable)
--- 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
 }