09/20: squash! Choose system-wide database if it's more recent.

[guix-commits]

civodul pushed a commit to branch wip-guix-index
in repository guix.

commit 50ca0a85142a8be12c7b5dec08aaffe51e8773b6
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun May 21 14:55:33 2023 +0200

    squash! Choose system-wide database if it's more recent.
---
 guix/scripts/index.scm | 45 +++++++++++++++++++++++++++++++++++----------
 1 file changed, 35 insertions(+), 10 deletions(-)

diff --git a/guix/scripts/index.scm b/guix/scripts/index.scm
index fd5535dc8a..4ff3433c75 100644
--- a/guix/scripts/index.scm
+++ b/guix/scripts/index.scm
@@ -18,6 +18,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix scripts index)
+  #:use-module ((guix config) #:select (%localstatedir))
   #:use-module ((guix i18n) #:select (G_))
   #:use-module ((guix ui)
                 #:select (show-version-and-exit
@@ -419,6 +420,26 @@ ON f.basename = :file
   (string-append (cache-directory #:ensure? #f)
                  "/index/db.sqlite"))
 
+(define system-database-file
+  ;; System-wide database file name.
+  (string-append %localstatedir "/cache/guix/index/db.sqlite"))
+
+(define (suitable-database create?)
+  "Return a suitable database file.  When CREATE? is true, the returned
+database will be opened for writing; otherwise, return the most recent one,
+user or system."
+  (if (zero? (getuid))
+      system-database-file
+      (if create?
+          user-database-file
+          (let ((system (stat system-database-file #f))
+                (user   (stat user-database-file #f)))
+            (if user
+                (if (and system (> (stat:mtime system) (stat:mtime user)))
+                    system-database-file
+                    user-database-file)
+                system-database-file)))))
+
 (define (show-help)
   (display (G_ "Usage: guix index [OPTIONS...] [search FILE...]
 Without argument, indexes (package, file) relationships from the machine.
@@ -465,19 +486,22 @@ See --database for customization.\n"))
            (lambda args (show-help) (exit 0)))
    (option '(#\V "version") #f #f
            (lambda (opt name arg result)
+             (catch 'quit
+               (lambda ()
+                 (show-version-and-exit "guix index"))
+               (const #f))
              (catch 'sqlite-error
                (lambda ()
-                 (let ((database (assoc-ref result 'database)))
-                   (simple-format
-                    #t
-                    "Extension local cache database:\n- path: ~a\n- version: 
~a\n\n"
-                    database (read-version-from-db database))))
-               (lambda (key . arg) 'no-db-yet-so-nothing-to-display))
-             (show-version-and-exit "guix index")))
+                 (let ((database ((assoc-ref result 'database)
+                                  (eq? (assoc-ref result 'action) 'index))))
+                   (info (G_ "database file '~a', schema version ~a~%")
+                         database (read-version-from-db database))))
+               (const #f))
+             (exit 0)))
    ;; index data out of the method (store or package)
    (option '(#\d "database") #f #t
            (lambda (opt name arg result)
-             (alist-cons 'database arg
+             (alist-cons 'database (const arg)
                          (alist-delete 'database result))))
 
    ;; index data out of the method (store or package)
@@ -491,7 +515,7 @@ See --database for customization.\n"))
                 (leave (G_ "~a: unknown indexing method~%"))))))))
 
 (define %default-options
-  `((database . ,user-database-file)
+  `((database . ,suitable-database)
     (method . manifests)))
 
 (define-command (guix-index . args)
@@ -537,7 +561,8 @@ See --database for customization.\n"))
                                          parse-sub-command))
            (args     (option-arguments opts))
            (action   (assoc-ref args 'action))
-           (database (assoc-ref args 'database))
+           (database ((assoc-ref args 'database)
+                      (eq? action 'index)))
            (method   (assoc-ref args 'method)))
       (match action
         ('search