diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | doc/guix.texi | 130 | ||||
| -rw-r--r-- | guix/scripts/locate.scm | 659 | ||||
| -rw-r--r-- | po/guix/POTFILES.in | 1 | ||||
| -rwxr-xr-x | tests/guix-locate.sh | 72 |
5 files changed, 864 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am index ab901df757..a386e6033c 100644 --- a/Makefile.am +++ b/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 \ diff --git a/doc/guix.texi b/doc/guix.texi index eb6cc9a875..c961f706ec 100644 --- a/doc/guix.texi +++ b/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} diff --git a/guix/scripts/locate.scm b/guix/scripts/locate.scm new file mode 100644 index 0000000000..aeaffa3d34 --- /dev/null +++ b/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)))))))) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 0431de522b..154ad4e530 100644 --- a/po/guix/POTFILES.in +++ b/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 diff --git a/tests/guix-locate.sh b/tests/guix-locate.sh new file mode 100755 index 0000000000..43f8ba53b0 --- /dev/null +++ b/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 |