Add 'guix locate'.

* guix/scripts/locate.scm, tests/guix-locate.sh: New files.
* Makefile.am (MODULES): Add 'guix/scripts/locate.scm'.
(SH_TESTS): Add 'tests/guix-locate.sh'.
* po/guix/POTFILES.in: Add it.
* doc/guix.texi (Invoking guix locate): New node.

Co-authored-by: Antoine R. Dumont <antoine.romain.dumont@gmail.com>

Makefile.am

@@ -306,6 +306,7 @@ MODULES =					\
   guix/scripts/archive.scm			\
   guix/scripts/import.scm			\
   guix/scripts/package.scm			\
+  guix/scripts/locate.scm			\
   guix/scripts/install.scm			\
   guix/scripts/remove.scm			\
   guix/scripts/upgrade.scm			\
@@ -595,6 +596,7 @@ SH_TESTS =					\
   tests/guix-gc.sh				\
   tests/guix-git-authenticate.sh		\
   tests/guix-hash.sh				\
+  tests/guix-locate.sh				\
   tests/guix-pack.sh				\
   tests/guix-pack-localstatedir.sh		\
   tests/guix-pack-relocatable.sh		\

doc/guix.texi

@@ -258,6 +258,7 @@ Package Management
 * Invoking guix package::       Package installation, removal, etc.
 * Substitutes::                 Downloading pre-built binaries.
 * Packages with Multiple Outputs::  Single source package, multiple outputs.
+* Invoking guix locate::        Locating packages that provide a file.
 * Invoking guix gc::            Running the garbage collector.
 * Invoking guix pull::          Fetching the latest Guix and distribution.
 * Invoking guix time-machine::  Running an older revision of Guix.
@@ -3297,6 +3298,7 @@ guix install emacs-guix
 * Invoking guix package::       Package installation, removal, etc.
 * Substitutes::                 Downloading pre-built binaries.
 * Packages with Multiple Outputs::  Single source package, multiple outputs.
+* Invoking guix locate::        Locating packages that provide a file.
 * Invoking guix gc::            Running the garbage collector.
 * Invoking guix pull::          Fetching the latest Guix and distribution.
 * Invoking guix time-machine::  Running an older revision of Guix.
@@ -4417,6 +4419,134 @@ the output of @command{guix package --list-available} (@pxref{Invoking
 guix package}).
 
 
+@node Invoking guix locate
+@section Invoking @command{guix locate}
+
+@cindex file, searching in packages
+@cindex file search
+@cindex searching for packages
+There's so much free software out there that sooner or later, you will
+need to search for packages.  The @command{guix search} command that
+we've seen before (@pxref{Invoking guix package}) lets you search by
+keywords:
+
+@example
+guix search video editor
+@end example
+
+@cindex searching for packages, by file name
+Sometimes, you instead want to find which package provides a given file,
+and this is where @command{guix locate} comes in.  Here is how you can
+find which package provides the @command{ls} command:
+
+@example
+$ guix locate ls
+coreutils@@9.1       /gnu/store/@dots{}-coreutils-9.1/bin/ls
+@end example
+
+Of course the command works for any file, not just commands:
+
+@example
+$ guix locate unistr.h
+icu4c@@71.1          /gnu/store/@dots{}/include/unicode/unistr.h
+libunistring@@1.0    /gnu/store/@dots{}/include/unistr.h
+@end example
+
+You may also specify @dfn{glob patterns} with wildcards.  For example,
+here is how you would search for packages providing @file{.service}
+files:
+
+@example
+$ guix locate -g '*.service'
+man-db@@2.11.1        @dots{}/lib/systemd/system/man-db.service
+wpa-supplicant@@2.10  @dots{}/system-services/fi.w1.wpa_supplicant1.service
+@end example
+
+The @command{guix locate} command relies on a database that maps file
+names to package names.  By default, it automatically creates that
+database if it does not exist yet by traversing packages available
+@emph{locally}, which can take a few minutes (depending on the size of
+your store and the speed of your storage device).
+
+@quotation Note
+For now, @command{guix locate} builds its database based on purely local
+knowledge---meaning that you will not find packages that never reached
+your store.  Eventually it will support downloading a pre-built database
+so you can potentially find more packages.
+@end quotation
+
+By default, @command{guix locate} first tries to look for a system-wide
+database, usually under @file{/var/cache/guix/locate}; if it does not
+exist or is too old, it falls back to the per-user database, by default
+under @file{~/.cache/guix/locate}.  On a multi-user system,
+administrators may want to periodically update the system-wide database
+so that all users can benefit from it.
+
+The general syntax is:
+
+@example
+guix locate [@var{options}@dots{}] @var{file}@dots{}
+@end example
+
+@noindent
+... where @var{file} is the name of a file to search for (specifically,
+the ``base name'' of the file: files whose parent directories are called
+@var{file} are not matched).
+
+The available options are as follows:
+
+@table @code
+@item --glob
+@item -g
+Interpret @var{file}@dots{} as @dfn{glob patterns}---patterns that may
+include wildcards, such as @samp{*.scm} to denote all files ending in
+@samp{.scm}.
+
+@item --stats
+Display database statistics.
+
+@item --update
+@itemx -u
+Update the file database.
+
+By default, the database is automatically updated when it is too old.
+
+@item --clear
+Clear the database and re-populate it.
+
+This option lets you start anew, ensuring old data is removed from the
+database, which also avoids having an endlessly growing database.  By
+default @command{guix locate} automatically does that periodically,
+though infrequently.
+
+@item --database=@var{file}
+Use @var{file} as the database, creating it if necessary.
+
+By default, @command{guix locate} picks the database under
+@file{~/.cache/guix} or @file{/var/cache/guix}, whichever is the most
+recent one.
+
+@item --method=@var{method}
+@itemx -m @var{method}
+Use @var{method} to select the set of packages to index.  Possible
+values are:
+
+@table @code
+@item manifests
+This is the default method: it works by traversing profiles on the
+machine and recording packages it encounters---packages you or other
+users of the machine installed, directly or indirectly.  It is fast but
+it can miss other packages available in the store but not referred to by
+any profile.
+
+@item store
+This is a slower but more exhaustive method: it checks among all the
+existing packages those that are available in the store and records
+them.
+@end table
+@end table
+
+
 @node Invoking guix gc
 @section Invoking @command{guix gc}
 

guix/scripts/locate.scm

@@ -0,0 +1,659 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2023 Antoine R. Dumont <antoine.romain.dumont@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts locate)
+  #:use-module ((guix config) #:select (%localstatedir))
+  #:use-module (guix i18n)
+  #:use-module ((guix ui)
+                #:select (show-version-and-exit
+                          show-bug-report-information
+                          with-error-handling
+                          string->number*
+                          display-hint
+                          leave-on-EPIPE))
+  #:use-module (guix diagnostics)
+  #:use-module (guix scripts)
+  #:use-module (sqlite3)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:autoload   (guix combinators) (fold2)
+  #:autoload   (guix grafts) (%graft?)
+  #:autoload   (guix store roots) (gc-roots)
+  #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:autoload   (guix progress) (progress-reporter/bar
+                                call-with-progress-reporter)
+  #:use-module (guix sets)
+  #:use-module ((guix utils) #:select (cache-directory))
+  #:autoload   (guix build utils) (find-files mkdir-p)
+  #:autoload   (gnu packages) (fold-packages)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
+  #:export     (guix-locate))
+
+(define %db-schema-version
+  ;; Current database schema version.
+  3)
+
+;; The following schema is the full schema at the `%db-schema-version`.  It
+;; should be modified according to the development required and
+;; `%db-schema-version` should be bumped. If the schema needs modification
+;; across time, those should be changed directly in the full-schema and the
+;; incremental changes should be referenced as migration step below for the
+;; new `%db-schema-version` (for the existing dbs to know what to migrate).
+(define %db-schema
+  "
+create table if not exists SchemaVersion (
+  version integer primary key not null,
+  date    integer,
+  store   text not null,    -- value of (%store-prefix)
+  unique (version)
+);
+
+create table if not exists Packages (
+  id        integer primary key autoincrement not null,
+  name      text not null,
+  version   text not null,
+  output    text,
+  unique    (name, version) -- add uniqueness constraint
+);
+
+create table if not exists Directories (
+  id        integer primary key autoincrement not null,
+  name      text not null,
+  package   integer not null,
+  foreign key (package) references Packages(id) on delete cascade,
+  unique (name, package) -- add uniqueness constraint
+);
+
+create table if not exists Files (
+  name      text not null,
+  basename  text not null,
+  directory integer not null,
+  foreign key (directory) references Directories(id) on delete cascade
+  unique (name, basename, directory) -- add uniqueness constraint
+);
+
+create index if not exists IndexFiles on Files(basename);")
+
+;; List of tuple ((version . sqlite schema migration script)). There should be
+;; as much version increments as step needed to migrate the db.
+(define schema-to-migrate '((1 . "
+create table if not exists SchemaVersion (
+  version integer primary key not null,
+  unique (version)
+);
+")
+                            (2 . "
+alter table SchemaVersion
+add column date date;
+")
+                            (3 . "
+alter table Packages
+add column output text;
+")))
+
+(define (call-with-database file proc)
+  (let ((db (sqlite-open file)))
+    (dynamic-wind
+      (lambda () #t)
+      (lambda ()
+        (ensure-latest-database-schema db)
+        (proc db))
+      (lambda () (sqlite-close db)))))
+
+(define (ensure-latest-database-schema db)
+  "Ensure DB follows the latest known version of the schema."
+  (define (initialize)
+    (sqlite-exec db %db-schema)
+    (insert-version db %db-schema-version))
+
+  (let ((version (false-if-exception (read-version db))))
+    (cond ((not version)
+           (initialize))
+          ((> version %db-schema-version)
+           (initialize))
+          (else
+           (catch #t
+             (lambda ()
+               ;; Migrate from the current version to the full migrated schema.
+               ;; This can raise sqlite-error if the db is not properly configured yet
+               (let loop ((current version))
+                 (when (< current %db-schema-version)
+                   ;; when the current db version is older than the current application
+                   (let* ((next (+ current 1))
+                          (migration (assoc-ref schema-to-migrate next)))
+                     (when migration
+                       (sqlite-exec db migration)
+                       (insert-version db next))
+                     (loop next)))))
+             (lambda _
+               ;; Exception handler in case failure to read an inexisting db:
+               ;; fallback to bootstrap the schema.
+               (initialize)))))))
+
+(define (last-insert-row-id db)        ;XXX: copied from (guix store database)
+  ;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'.
+  ;; Work around that.
+  (define stmt
+    (sqlite-prepare db "SELECT last_insert_rowid();"
+                    #:cache? #t))
+  (match (sqlite-fold cons '() stmt)
+    ((#(id)) id)
+    (_ #f)))
+
+(define (insert-version db version)
+  "Insert application VERSION into the DB."
+  (define stmt-insert-version
+    (sqlite-prepare db "\
+INSERT OR IGNORE INTO SchemaVersion(version, date, store)
+VALUES (:version, CURRENT_TIMESTAMP, :store);"
+                    #:cache? #t))
+  (sqlite-exec db "begin immediate;")
+  (sqlite-bind-arguments stmt-insert-version
+                         #:version version
+                         #:store (%store-prefix))
+  (sqlite-fold (const #t) #t stmt-insert-version)
+  (sqlite-exec db "commit;"))
+
+(define (read-version db)
+  "Read the current application version from the DB."
+
+  (define stmt-select-version (sqlite-prepare db "\
+SELECT version FROM SchemaVersion ORDER BY version DESC LIMIT 1;"
+                                              #:cache? #f))
+  (match (sqlite-fold cons '() stmt-select-version)
+    ((#(version))
+     version)))
+
+(define user-database-file
+  ;; Default user database file name.
+  (string-append (cache-directory #:ensure? #f)
+                 "/locate/db.sqlite"))
+
+(define system-database-file
+  ;; System-wide database file name.
+  (string-append %localstatedir "/cache/guix/locate/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)
+                (if system
+                    system-database-file
+                    user-database-file))))))
+
+(define (clear-database db)
+  "Drop packages and files from DB."
+  (sqlite-exec db "BEGIN IMMEDIATE;")
+  (sqlite-exec db "DELETE FROM Files;")
+  (sqlite-exec db "DELETE FROM Directories;")
+  (sqlite-exec db "DELETE FROM Packages;")
+  (sqlite-exec db "COMMIT;")
+  (sqlite-exec db "VACUUM;"))
+
+(define (print-statistics file)
+  "Print statistics about the database in FILE."
+  (define (count db table)
+    (define stmt
+      (sqlite-prepare
+       db (string-append "SELECT COUNT(*) FROM " table ";")))
+
+    (match (sqlite-fold cons '() stmt)
+      ((#(number)) number)))
+
+  (call-with-database file
+    (lambda (db)
+      (format #t (G_ "schema version:\t~a~%")
+              (read-version db))
+      (format #t (G_ "number of packages:\t~9h~%")
+              (count db "Packages"))
+      (format #t (G_ "number of files:\t~9h~%")
+              (count db "Files"))
+      (format #t (G_ "database size:\t~9h MiB~%")
+              (inexact->exact
+               (round (/ (stat:size (stat file))
+                         (expt 2 20))))))))
+
+
+;;;
+;;; Indexing from local packages.
+;;;
+
+(define (insert-files db package version outputs directories)
+  "Insert DIRECTORIES files belonging to VERSION PACKAGE (with OUTPUTS)."
+  (define stmt-select-package
+    (sqlite-prepare db "\
+SELECT id FROM Packages WHERE name = :name AND version = :version LIMIT 1;"
+                    #:cache? #t))
+
+  (define stmt-insert-package
+    (sqlite-prepare db "\
+INSERT OR IGNORE INTO Packages(name, version, output)
+VALUES (:name, :version, :output);"
+                    #:cache? #t))
+
+  (define stmt-select-directory
+    (sqlite-prepare db "\
+SELECT id FROM Directories WHERE package = :package;"
+                    #:cache? #t))
+
+  (define stmt-insert-directory
+    (sqlite-prepare db "\
+INSERT OR IGNORE INTO Directories(name, package) -- to avoid spurious writes
+VALUES (:name, :package);"
+                    #:cache? #t))
+
+  (define stmt-insert-file
+    (sqlite-prepare db "\
+INSERT OR IGNORE INTO Files(name, basename, directory)
+VALUES (:name, :basename, :directory);"
+                    #:cache? #t))
+
+  (sqlite-exec db "begin immediate;")
+  ;; 1 record per output
+  (for-each (lambda (output)
+              (sqlite-reset stmt-insert-package)
+              (sqlite-bind-arguments stmt-insert-package
+                                     #:name package
+                                     #:version version
+                                     #:output output)
+              (sqlite-fold (const #t) #t stmt-insert-package))
+            outputs)
+  (sqlite-bind-arguments stmt-select-package
+                         #:name package
+                         #:version version)
+  (match (sqlite-fold cons '() stmt-select-package)
+    ((#(package-id))
+     (for-each (lambda (directory)
+                 (define (strip file)
+                   (string-drop file (+ (string-length directory) 1)))
+
+                 ;; If there's already a directory associated with PACKAGE-ID,
+                 ;; not necessarily the same directory, skip it.  That keeps
+                 ;; the database slimmer at the expense of not recording
+                 ;; variants of the same package; it also makes indexing
+                 ;; faster.
+                 (sqlite-reset stmt-select-directory)
+                 (sqlite-bind-arguments stmt-select-directory
+                                        #:package package-id)
+                 (when (null? (sqlite-fold cons '() stmt-select-directory))
+                   ;; DIRECTORY is missing so insert it and traverse it.
+                   (sqlite-reset stmt-insert-directory)
+                   (sqlite-bind-arguments stmt-insert-directory
+                                          #:name (store-path-base directory)
+                                          #:package package-id)
+                   (sqlite-fold (const #t) #t stmt-insert-directory)
+
+                   (let ((directory-id (last-insert-row-id db)))
+                     (for-each (lambda (file)
+                                 ;; If DIRECTORY is a symlink, (find-files
+                                 ;; DIRECTORY) returns the DIRECTORY singleton.
+                                 (unless (string=? file directory)
+                                   (sqlite-reset stmt-insert-file)
+                                   (sqlite-bind-arguments stmt-insert-file
+                                                          #:name (strip file)
+                                                          #:basename
+                                                          (basename file)
+                                                          #:directory
+                                                          directory-id)
+                                   (sqlite-fold (const #t) #t stmt-insert-file)))
+                               (find-files directory)))))
+               directories)))
+  (sqlite-exec db "commit;"))
+
+(define (insert-package db package)
+  "Insert all the files of PACKAGE into DB."
+  (define stmt-select-package-output
+    (sqlite-prepare db "\
+SELECT output FROM Packages WHERE name = :name AND version = :version"
+                    #:cache? #t))
+
+  (define (known-outputs package)
+    ;; Return the list of outputs of PACKAGE already in DB.
+    (sqlite-bind-arguments stmt-select-package-output
+                           #:name (package-name package)
+                           #:version (package-version package))
+    (match (sqlite-fold cons '() stmt-select-package-output)
+      ((#(outputs ...)) outputs)
+      (() '())))
+
+  (with-monad %store-monad
+    ;; Since calling 'package->derivation' is expensive, do not call it if the
+    ;; outputs of PACKAGE at VERSION are already in DB.
+    (munless (lset= string=?
+                    (known-outputs package)
+                    (package-outputs package))
+      (mlet %store-monad ((drv (package->derivation package #:graft? #f)))
+        (match (derivation->output-paths drv)
+          (((labels . directories) ...)
+           (when (every file-exists? directories)
+             (insert-files
+              db (package-name package) (package-version package) (package-outputs package)
+              directories))
+           (return #t)))))))
+
+(define (insert-packages-with-progress db packages insert-package)
+  "Insert PACKAGES into DB with progress bar reporting, calling INSERT-PACKAGE
+for each package to insert."
+  (let* ((count    (length packages))
+         (prefix   (format #f (G_ "indexing ~h packages") count))
+         (progress (progress-reporter/bar count prefix)))
+    (call-with-progress-reporter progress
+      (lambda (report)
+        (for-each (lambda (package)
+                    (insert-package db package)
+                    (report))
+                  packages)))))
+
+(define (index-packages-from-store-with-db db)
+  "Index local store packages using DB."
+  (with-store store
+    (parameterize ((%graft? #f))
+      (define (insert-package-from-store db package)
+        (run-with-store store (insert-package db package)))
+      (let ((packages (fold-packages
+                       cons
+                       '()
+                       #:select? (lambda (package)
+                                   (and (not (hidden-package? package))
+                                        (not (package-superseded package))
+                                        (supported-package? package))))))
+        (insert-packages-with-progress
+         db packages insert-package-from-store)))))
+
+
+;;;
+;;; Indexing from local profiles.
+;;;
+
+(define (all-profiles)
+  "Return the list of system profiles."
+  (delete-duplicates
+   (filter-map (lambda (root)
+                 (if (file-exists? (string-append root "/manifest"))
+                     root
+                     (let ((root (string-append root "/profile")))
+                       (and (file-exists? (string-append root "/manifest"))
+                            root))))
+               (gc-roots))))
+
+(define (profiles->manifest-entries profiles)
+  "Return deduplicated manifest entries across all PROFILES."
+  (let loop ((visited (set))
+             (profiles profiles)
+             (entries '()))
+    (match profiles
+      (()
+       entries)
+      ((profile . rest)
+       (let* ((manifest (profile-manifest profile))
+              (entries visited
+                       (fold2 (lambda (entry lst visited)
+                                (let ((item (manifest-entry-item entry)))
+                                  (if (set-contains? visited item)
+                                      (values lst visited)
+                                      (values (cons entry lst)
+                                              (set-insert item
+                                                          visited)))))
+                              entries
+                              visited
+                              (manifest-transitive-entries manifest))))
+         (loop visited rest entries))))))
+
+(define (insert-manifest-entry db entry)
+  "Insert a manifest ENTRY into DB."
+  (insert-files db (manifest-entry-name entry)
+                (manifest-entry-version entry)
+                (list (manifest-entry-output entry))
+                (list (manifest-entry-item entry)))) ;FIXME: outputs?
+
+(define (index-packages-from-manifests-with-db db)
+  "Index packages entries into DB from the system manifests."
+  (info (G_ "traversing local profile manifests...~%"))
+  (let ((entries (profiles->manifest-entries (all-profiles))))
+    (insert-packages-with-progress db entries insert-manifest-entry)))
+
+
+
+;;;
+;;; Search.
+;;;
+
+(define-record-type <package-match>
+  (package-match name version output file)
+  package-match?
+  (name    package-match-name)
+  (version package-match-version)
+  (output  package-match-output)
+  (file    package-match-file))
+
+(define* (matching-packages db file #:key glob?)
+  "Return a list of <package-match> records, one for each package containing
+FILE.  When GLOB? is true, interpret FILE as a glob pattern."
+  (define match-stmt
+    (if glob?
+        "f.basename GLOB :file"
+        "f.basename = :file"))
+
+  (define lookup-stmt
+    (sqlite-prepare db (string-append "\
+SELECT p.name, p.version, p.output, d.name, f.name
+FROM Packages p
+INNER JOIN Files f, Directories d
+ON " match-stmt "
+  AND d.id = f.directory
+  AND p.id = d.package;")))
+
+  (define prefix
+    (match (sqlite-fold (lambda (value _) value)
+                        #f
+                        (sqlite-prepare db "SELECT store FROM SchemaVersion;"))
+      (#(prefix) prefix)))
+
+  (sqlite-bind-arguments lookup-stmt #:file file)
+  (sqlite-fold (lambda (result lst)
+                 (match result
+                   (#(package version output directory file)
+                    (cons (package-match package version output
+                                         (string-append prefix "/"
+                                                        directory "/" file))
+                          lst))))
+               '() lookup-stmt))
+
+(define (print-matching-results matches)
+  "Print the MATCHES matching results."
+  (for-each (lambda (result)
+              (let ((name    (package-match-name result))
+                    (version (package-match-version result))
+                    (output  (package-match-output result))
+                    (file    (package-match-file result)))
+                (format #t "~20a ~a~%"
+                        (string-append name "@" version
+                                       (match output
+                                         ("out" "")
+                                         (_ (string-append ":" output))))
+                        file)))
+            matches))
+
+
+;;;
+;;; Options.
+;;;
+
+(define (show-help)
+  (display (G_ "Usage: guix locate [OPTIONS...] FILE...
+Locate FILE and return the list of packages that contain it.\n"))
+  (display (G_ "
+  -g, --glob          interpret FILE as a glob pattern"))
+  (display (G_ "
+      --stats         display database statistics"))
+  (display (G_ "
+  -u, --update        force a database update"))
+  (display (G_ "
+      --clear         clear the database"))
+  (display (G_ "
+      --database=FILE store the database in FILE"))
+  (newline)
+  (display (G_ "
+      --method=METHOD use METHOD to select packages to index; METHOD can
+                      be 'manifests' (fast) or 'store' (slower)"))
+  (newline)
+  (display (G_ "
+  -h, --help          display this help and exit"))
+  (display (G_ "
+  -V, --version       display version information and exit"))
+  (show-bug-report-information))
+
+(define %options
+  (list (option '(#\h "help") #f #f
+                (lambda args (show-help) (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda (opt name arg result)
+                  (show-version-and-exit "guix locate")))
+        (option '(#\g "glob") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'glob? #t result)))
+        (option '("stats") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'stats? #t result)))
+        (option '("database") #f #t
+                (lambda (opt name arg result)
+                  (alist-cons 'database (const arg)
+                              (alist-delete 'database result))))
+        (option '(#\u "update") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'update? #t result)))
+        (option '("clear") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'clear? #t result)))
+        (option '(#\m "method") #f #t
+                (lambda (opt name arg result)
+                  (match arg
+                    ((or "manifests" "store")
+                     (alist-cons 'method (string->symbol arg)
+                                 (alist-delete 'method result)))
+                    (_
+                     (leave (G_ "~a: unknown indexing method~%"))))))))
+
+(define %default-options
+  `((database . ,suitable-database)
+    (method . manifests)))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define-command (guix-locate . args)
+  (category packaging)
+  (synopsis "search for packages providing a given file")
+
+  (define age-update-threshold
+    ;; Time since database modification after which an update is triggered.
+    (* 2 30 (* 24 60 60)))
+
+  (define age-cleanup-threshold
+    ;; Time since database modification after which it is cleared.  This is to
+    ;; avoid having stale info in the database and an endlessly growing
+    ;; database.
+    (* 9 30 (* 24 60 60)))
+
+  (define (file-age stat)
+    ;; Return true if TIME denotes an "old" time.
+    (- (current-time) (stat:mtime stat)))
+
+  (with-error-handling
+    (let* ((opts     (parse-command-line args %options
+                                         (list %default-options)
+                                         #:build-options? #f
+                                         #:argument-handler
+                                         (lambda (arg result)
+                                           (alist-cons 'argument arg
+                                                       result))))
+           (clear?   (assoc-ref opts 'clear?))
+           (update?  (assoc-ref opts 'update?))
+           (glob?    (assoc-ref opts 'glob?))
+           (database ((assoc-ref opts 'database) update?))
+           (method   (assoc-ref opts 'method))
+           (files    (reverse (filter-map (match-lambda
+                                            (('argument . arg) arg)
+                                            (_ #f))
+                                          opts))))
+      (define* (populate-database database clear?)
+        (mkdir-p (dirname database))
+        (call-with-database database
+          (lambda (db)
+            (when clear?
+              (clear-database db))
+            (match method
+              ('manifests
+               (index-packages-from-manifests-with-db db))
+              ('store
+               (index-packages-from-store-with-db db))
+              (_
+               (leave (G_ "~a: unknown indexing method~%") method))))))
+
+      ;; Populate the database if needed.
+      (let* ((stat   (stat database #f))
+             (age    (and stat (file-age stat)))
+             (clear? (or clear?
+                         (and age (>= age age-cleanup-threshold)))))
+        (when (or update? clear?
+                  (not stat)
+                  (>= age age-update-threshold))
+          (when clear?
+            (info (G_ "clearing database...~%")))
+          (info (G_ "indexing files from ~a...~%") (%store-prefix))
+          (populate-database database clear?)))
+
+      (if (assoc-ref opts 'stats?)
+          (print-statistics database)
+          (match (call-with-database database
+                   (lambda (db)
+                     (append-map (lambda (file)
+                                   (matching-packages db file
+                                                      #:glob? glob?))
+                                 files)))
+            (()
+             (if (null? files)
+                 (unless update?
+                   (leave (G_ "no files to search for~%")))
+                 (leave (N_ "file~{ '~a'~} not found in database '~a'~%"
+                            "files~{ '~a'~} not found in database '~a'~%"
+                            (length files))
+                        files database)))
+            (matches
+             (leave-on-EPIPE
+              (print-matching-results matches))))))))

po/guix/POTFILES.in

@@ -111,6 +111,7 @@ guix/scripts/system.scm
 guix/scripts/system/edit.scm
 guix/scripts/system/search.scm
 guix/scripts/lint.scm
+guix/scripts/locate.scm
 guix/scripts/publish.scm
 guix/scripts/edit.scm
 guix/scripts/size.scm

tests/guix-locate.sh

@@ -0,0 +1,72 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2023 Antoine R. Dumont <antoine.romain.dumont@gmail.com>
+# Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the 'guix locate' command-line utility.
+#
+
+set -x
+
+RUN_EXPENSIVE_TESTS="${RUN_EXPENSIVE_TESTS:-false}"
+
+tmpdir="guix-index-$$"
+# In the following tests, we use two different databases, one for each
+# indexation method.
+tmpdb_manifests="$tmpdir/manifests/db.sqlite"
+tmpdb_store="$tmpdir/store/db.sqlite"
+trap 'rm -rf "$tmpdir" "$tmpdb_store" "$tmpdb_manifests"' EXIT
+
+guix locate --version
+
+# Preparing db locations for both indexation methods.
+mkdir -p "$(dirname "$tmpdb_manifests")" "$(dirname "$tmpdb_store")"
+
+cmd_manifests="guix locate --database=$tmpdb_manifests --method=manifests"
+cmd_store="guix locate --database=$tmpdb_store --method=store"
+
+# Lookup without any db should fail.
+guix locate --database="$tmpdb_manifests" guile && false
+guix locate --database="$tmpdb_store" guile && false
+
+# Lookup without anything in db should yield no results because the indexer
+# didn't stumble upon any profile.
+test -z "$(guix locate --database="$tmpdb_manifests" guile)"
+
+# Install a package.
+guix package --bootstrap --install guile-bootstrap \
+     --profile="$tmpdir/profile"
+
+# Look for 'guile'.
+$cmd_manifests --update
+$cmd_manifests guile | grep "$(guix build guile-bootstrap)/bin/guile"
+$cmd_manifests boot-9.scm | grep ^guile-bootstrap
+
+# Using a glob pattern.
+$cmd_manifests -g '*.scm' | grep "^guile-bootstrap.*boot-9"
+
+# Statistics.
+$cmd_manifests --stats
+
+if $RUN_EXPENSIVE_TESTS
+then
+    $cmd_store --update
+    $cmd_store guile
+    $cmd_store guile | grep "$(guix build guile-bootstrap)/bin/guile"
+    $cmd_store boot-9.scm | grep ^guile-bootstrap
+fi