image: Do not set journal_model=WAL for the Hurd.

This fixes <https://bugs.gnu.org/42151>.

* gnu/system/images/hurd.scm (hurd-initialize-root-partition): Use #:wal-mode #f
in call to ...
* gnu/build/image.scm (initialize-root-partition): ... this, add #:wal-mode?
parameter, pass it to ...
(register-closure): ... this, add #:wal-mode? parameter, pass it to ...
* guix/store/database.scm (with-database): ... this, add #:wal-mode?
parameter, pass it to ...
(call-with-database): ... this, add #:wal-mode? parameter; when
set to #f, do not set journal_model=WAL.

3 files changed, 42 insertions, 21 deletions

diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index e7b0418182..d8efa73f16 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -131,20 +131,23 @@ given CONFIG file."
 (define* (register-closure prefix closure
                            #:key
                            (deduplicate? #t) (reset-timestamps? #t)
-                           (schema (sql-schema)))
+                           (schema (sql-schema))
+                           (wal-mode? #t))
   "Register CLOSURE in PREFIX, where PREFIX is the directory name of the
 target store and CLOSURE is the name of a file containing a reference graph as
 produced by #:references-graphs..  As a side effect, if RESET-TIMESTAMPS? is
 true, reset timestamps on store files and, if DEDUPLICATE? is true,
-deduplicates files common to CLOSURE and the rest of PREFIX."
+deduplicates files common to CLOSURE and the rest of PREFIX.  Pass WAL-MODE?
+to call-with-database."
   (let ((items (call-with-input-file closure read-reference-graph)))
     (parameterize ((sql-schema schema))
       (with-database (store-database-file #:prefix prefix) db
-        (register-items db items
-                        #:prefix prefix
-                        #:deduplicate? deduplicate?
-                        #:reset-timestamps? reset-timestamps?
-                        #:registration-time %epoch)))))
+       #:wal-mode? wal-mode?
+       (register-items db items
+                       #:prefix prefix
+                       #:deduplicate? deduplicate?
+                       #:reset-timestamps? reset-timestamps?
+                       #:registration-time %epoch)))))
 
 (define* (initialize-efi-partition root
                                    #:key
@@ -164,14 +167,16 @@ deduplicates files common to CLOSURE and the rest of PREFIX."
                                     (register-closures? #t)
                                     system-directory
                                     make-device-nodes
+                                    (wal-mode? #t)
                                     #:allow-other-keys)
   "Initialize the given ROOT directory. Use BOOTCFG and BOOTCFG-LOCATION to
 install the bootloader configuration.
 
 If REGISTER-CLOSURES? is true, register REFERENCES-GRAPHS in the store.  If
 DEDUPLICATE? is true, then also deduplicate files common to CLOSURES and the
-rest of the store when registering the closures. SYSTEM-DIRECTORY is the name
-of the directory of the 'system' derivation."
+rest of the store when registering the closures.  SYSTEM-DIRECTORY is the name
+of the directory of the 'system' derivation.  Pass WAL-MODE? to
+register-closure."
   (populate-root-file-system system-directory root)
   (populate-store references-graphs root)
 
@@ -184,7 +189,8 @@ of the directory of the 'system' derivation."
                 (register-closure root
                                   closure
                                   #:reset-timestamps? #t
-                                  #:deduplicate? deduplicate?))
+                                  #:deduplicate? deduplicate?
+                                  #:wal-mode? wal-mode?))
               references-graphs))
 
   (when bootloader-installer
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 31942e7386..d87640e8e3 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -61,8 +61,12 @@
   #~(lambda* (#:rest args)
       (apply initialize-root-partition
              (append args
-                     (list #:make-device-nodes
-                           make-hurd-device-nodes)))))
+                     (list #:make-device-nodes make-hurd-device-nodes
+                           ;; XXX Creating a db.sqlite with journal_mode=WAL
+                           ;; yields "unable to open database file" on GNU/Hurd
+                           ;; for an sqlite with the hurd-locking-mode.patch;
+                           ;; see <https://bugs.gnu.org/42151>.
+                           #:wal-mode? #f)))))
 
 (define hurd-disk-image
   (image
diff --git a/guix/store/database.scm b/guix/store/database.scm
index a38e4d7e52..50b66ce282 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2019 Caleb Ristvedt <caleb.ristvedt@cune.org>
 ;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@
 (define-module (guix store database)
   #:use-module (sqlite3)
   #:use-module (guix config)
+  #:use-module (guix gexp)
   #:use-module (guix serialization)
   #:use-module (guix store deduplication)
   #:use-module (guix base16)
@@ -27,6 +29,7 @@
   #:use-module (guix build syscalls)
   #:use-module ((guix build utils)
                 #:select (mkdir-p executable-file?))
+  #:use-module (guix utils)
   #:use-module (guix build store-copy)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -97,17 +100,20 @@ as specified by SQL-SCHEMA."
 
   (sqlite-exec db (call-with-input-file schema get-string-all)))
 
-(define (call-with-database file proc)
+(define* (call-with-database file proc #:key (wal-mode? #t))
   "Pass PROC a database record corresponding to FILE.  If FILE doesn't exist,
-create it and initialize it as a new database."
+create it and initialize it as a new database.  Unless WAL-MODE? is set to #f,
+set journal_mode=WAL."
   (let ((new? (and (not (file-exists? file))
                    (begin
                      (mkdir-p (dirname file))
                      #t)))
         (db   (sqlite-open file)))
-    ;; Turn DB in "write-ahead log" mode, which should avoid SQLITE_LOCKED
-    ;; errors when we have several readers: <https://www.sqlite.org/wal.html>.
-    (sqlite-exec db "PRAGMA journal_mode=WAL;")
+    ;; Using WAL breaks for the Hurd <https://bugs.gnu.org/42151>.
+    (when wal-mode?
+      ;; Turn DB in "write-ahead log" mode, which should avoid SQLITE_LOCKED
+      ;; errors when we have several readers: <https://www.sqlite.org/wal.html>.
+      (sqlite-exec db "PRAGMA journal_mode=WAL;"))
 
     ;; Install a busy handler such that, when the database is locked, sqlite
     ;; retries until 30 seconds have passed, at which point it gives up and
@@ -200,10 +206,15 @@ prior to returning."
   ;; Default location of the store database.
   (string-append %store-database-directory "/db.sqlite"))
 
-(define-syntax-rule (with-database file db exp ...)
-  "Open DB from FILE and close it when the dynamic extent of EXP... is left.
-If FILE doesn't exist, create it and initialize it as a new database."
-  (call-with-database file (lambda (db) exp ...)))
+(define-syntax with-database
+  (syntax-rules ()
+    "Open DB from FILE and close it when the dynamic extent of EXP... is left.
+If FILE doesn't exist, create it and initialize it as a new database.  Pass
+#:wal-mode? to call-with-database."
+    ((_ file db #:wal-mode? wal-mode? exp ...)
+     (call-with-database file (lambda (db) exp ...) #:wal-mode? wal-mode?))
+    ((_ file db exp ...)
+     (call-with-database file (lambda (db) exp ...)))))
 
 (define (sqlite-finalize stmt)
   ;; As of guile-sqlite3 0.1.0, cached statements aren't reset when