* [bug#62264] [PATCH core-updates 0/6] Add `guix index` subcommand
@ 2023-03-18 16:06 Antoine R. Dumont (@ardumont)
2023-03-18 16:57 ` [bug#62264] [PATCH core-updates 1-6/6] " Antoine R. Dumont
2023-04-02 21:57 ` [bug#62264] [PATCH core-updates 0/6] " Ludovic Courtès
0 siblings, 2 replies; 28+ messages in thread
From: Antoine R. Dumont (@ardumont) @ 2023-03-18 16:06 UTC (permalink / raw)
To: 62264
[-- Attachment #1: Type: text/plain, Size: 8370 bytes --]
Hello,
This introduces a new `guix index` subcommand (initiated by
civodul). This is in charge of indexing guix packages to ease user
lookups. There are 2 indexation methods:
- `manifest`: fast but less efficient, expected to be used by local
users
- `store`: slow but more efficient, expected to be used on a guix build
machine. Another service could be in charge of exposing a search
package service to ease remote search of packages.
** Impact (positive)
tl;dr This is an equivalent of `nix-index/nix-locate` or `apt-file
search` cli we can find respectively in Nix or Debian's toolbox
(unbeknownst of their implementation).
This should help users transitioning from other distributions. Usually,
people will want to look up for files or packages they are already
using. They'd expect an easy way to find those back in guix. And we
currently cannot do so easily. We can ask on #guix-devel irc (as someone
mentions to me there) though that's not scalable nor really practical
for non-irc users.
** How did I test/run it?
I've been running both the:
- `guix index` subcommand to index packages (with both methods in
separated or not dbs).
- `guix index search FILE` to actually search for packages present in
the db
I've inspected time and again the db through the `sqlite3` program after
multiple runs too to ensure data were consistent. Data are consistent.
** Build?
The makefile routine will build that subcommand too.
** Development details
The backend technology is sqlite3. The command is in charge of migrating
the data model (if any). That data model migration process is
transparent for users. The data model is currently at version 3 because
it underwent some migrations during its development process
already. It's kept for dogfooding and examples reasons.
The --version flag mentions the default backend locations and data model
version:
--8<---------------cut here---------------end--------------->8---
$ guix index --version
Extension local cache database:
- path: /home/tony/.cache/guix/index/db.sqlite
- version: 3
guix index (GNU Guix) 1.4.0.3874-372b2
Copyright (C) 2023 the Guix authors
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
$ git log | head -1
commit 372b2b9660b8293eebd6280bb46a4ec07d4192a7
--8<---------------cut here---------------end--------------->8---
** Current caveat ("help needed on test")
The code works but...
I can't make the integration test i wrote work. Hence my delay to send
the overall patch (as the subcommand has been ready for a while). As
it's been way too long already, I've posted it in the hope someone
interested enough sees what's missing. Thanks in advance.
What's happening during the test is that somehow the execution of the
`guix index` subcommand triggers an exit code > 0 (error). Which,
expectedly, stops the test immediately. I don't get why the subcommand
exits that way and I don't see how to dig further unfortunately. Any
clues would be very much appreciated.
** Use
The subcommand is documented exhaustively.
--8<---------------cut here---------------end--------------->8---
$ guix index --help
Usage: guix index [OPTIONS...] [search FILE...]
Without argument, indexes (package, file) relationships from the machine.
This allows indexation with 2 methods, out of the local:
- manifests: This is the fastest implementation with the caveat of indexing
less packages. That'd be typically the use case of user local indexation.
- store: This is slowest implementation. It discusses with the store
daemon. That'd be typically the use case of building the largest db in one of
the build farm node.
With 'search FILE', search for packages installing FILE.
Note: Internal cache is located at ~/.cache/guix/index/db.sqlite by default.
See --db-path for customization.
The valid values for OPTIONS are:
-h, --help Display this help and exit
-V, --version Display version information and exit
--db-path=DIR Change default location of the cache db
--method=METH Change default indexation method. By default it uses the
local "manifests" (faster). It can also uses the local
"store" (slower, typically on the farm build ci).
The valid values for ARGS are:
search FILE Search for packages installing the FILE (from cache db)
<EMPTY> Without any argument, it index packages. This fills in the
db cache using whatever indexation method is defined.
Report bugs to: bug-guix@gnu.org.
GNU Guix home page: <https://www.gnu.org/software/guix/>
General help using Guix and GNU software: <https://guix.gnu.org/en/help/>
--8<---------------cut here---------------end--------------->8---
Example of an indexation (fast method by default):
--8<---------------cut here---------------end--------------->8---
$ guix index
Registering 133 packages ▕█████▎ ▏
--8<---------------cut here---------------end--------------->8---
Example of a search:
--8<---------------cut here---------------end--------------->8---
$ guix index search sqlite3
sqlite@3.37.0 /gnu/store/jd6nn2c8ln5flv4vwl7pp1w804w2i9wj-sqlite-3.37.0/bin/sqlite3
sqlite@3.36.0 /gnu/store/xmzx5mzv4863yw9kmr2ykndgp37p8if0-sqlite-3.36.0/bin/sqlite3
--8<---------------cut here---------------end--------------->8---
Note: inspired from zimoun's way of quoting (/me like those, thx ;)
** Development process (optional read)
Note that this started as a subcommand (again from civodul's bootstrap
code). Then as a good proposal from zimoun, this got simplified into a
guix extension (awesome work zimoun ;). Fwiw, developing it as an
extension felt way simpler for dev and run. Versus, having to setup my
machines to develop with guix. It continued as a guix subcommand in the
end as civodul proposed it that way instead.
Sent from my MUA as git-send-email would not work...
--8<---------------cut here---------------end--------------->8---
$ git send-email outgoing/0000-cover-letter.patch -a \
--to=guix-patches@gnu.org
outgoing/0000-cover-letter.patch
Can't exec "sh": No such file or directory at
/gnu/store/xsj89hs359iblyxxi74pw6pyprdfbm5m-git-2.36.1-send-email/libexec/git-core/.git-send-email-real
line 231.
the editor exited uncleanly, aborting everything at
/gnu/store/xsj89hs359iblyxxi74pw6pyprdfbm5m-git-2.36.1-send-email/libexec/git-core/.git-send-email-real
line 252.
--8<---------------cut here---------------end--------------->8---
Hoping this finds you well nonetheless.
Cheers,
--
tony / Antoine R. Dumont (@ardumont)
-----------------------------------------------------------------
gpg fingerprint BF00 203D 741A C9D5 46A8 BE07 52E2 E984 0D10 C3B8
===File ~/repo/public/guix/guix/outgoing/0000-cover-letter.patch===
From 372b2b9660b8293eebd6280bb46a4ec07d4192a7 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Sat, 18 Mar 2023 16:27:22 +0100
Subject: [PATCH core-updates 0/6] Add `guix index` subcommand
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
*** BLURB HERE ****
Antoine R. Dumont (@ardumont) (5):
scripts-index: Transform `guix index` extension into a Guix script
scripts-index: Store outputs alongside packages
Makefile.am: Reference new script to compile
Bootstrap tests for guix index subcommand
Allow gcroot function to exceptionally ignore error
Ludovic Courtès (1):
index: Add initial implementation from civodul
Makefile.am | 2 +
guix/scripts/home.scm | 2 +-
guix/scripts/index.scm | 595 +++++++++++++++++++++++++++++++++++++++++
guix/store/roots.scm | 10 +-
tests/guix-index.sh | 73 +++++
tests/store-roots.scm | 7 +-
6 files changed, 686 insertions(+), 3 deletions(-)
create mode 100644 guix/scripts/index.scm
create mode 100755 tests/guix-index.sh
base-commit: 962277fd4313f20c0e0333effbd88352c0a7d461
--
2.36.1
============================================================
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 877 bytes --]
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH core-updates 1-6/6] Add `guix index` subcommand
2023-03-18 16:06 [bug#62264] [PATCH core-updates 0/6] Add `guix index` subcommand Antoine R. Dumont (@ardumont)
@ 2023-03-18 16:57 ` Antoine R. Dumont
2023-04-02 21:57 ` [bug#62264] [PATCH core-updates 0/6] " Ludovic Courtès
1 sibling, 0 replies; 28+ messages in thread
From: Antoine R. Dumont @ 2023-03-18 16:57 UTC (permalink / raw)
To: 62264
[-- Attachment #1.1: Type: text/plain, Size: 314 bytes --]
Hello again,
please find enclosed the remaining patches holding the actual guix
subcommand as described in the introductory email.
Cheers,
--
tony / Antoine R. Dumont (@ardumont)
-----------------------------------------------------------------
gpg fingerprint BF00 203D 741A C9D5 46A8 BE07 52E2 E984 0D10 C3B8
[-- Attachment #1.2: 0001-index-Add-initial-implementation-from-civodul.patch --]
[-- Type: text/x-diff, Size: 25196 bytes --]
From 869d8b4cc7cefb6d7dbe9cd1374242bf6d7c953d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 30 Nov 2022 15:25:21 +0100
Subject: [PATCH core-updates 1/6] index: Add initial implementation from
civodul
Related to https://lists.gnu.org/archive/html/guix-devel/2022-01/msg00354.html
---
guix/extensions/index.scm | 574 ++++++++++++++++++++++++++++++++++++++
guix/scripts/home.scm | 2 +-
2 files changed, 575 insertions(+), 1 deletion(-)
create mode 100644 guix/extensions/index.scm
diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm
new file mode 100644
index 0000000000..d9894b213e
--- /dev/null
+++ b/guix/extensions/index.scm
@@ -0,0 +1,574 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 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/>.
+
+(define-module (guix extensions index)
+ #:use-module ((guix i18n) #:select (G_))
+ #:use-module ((guix ui) #:select (show-version-and-exit
+ show-bug-report-information
+ with-error-handling
+ string->number*))
+ #:use-module (guix scripts)
+ #:use-module (sqlite3)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 getopt-long)
+ #:use-module (guix describe)
+ #: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)
+ #:use-module ((guix progress) #:select (progress-reporter/bar
+ call-with-progress-reporter))
+ #:use-module (guix sets)
+ #:use-module ((guix utils) #:select (cache-directory))
+ #:autoload (guix build utils) (find-files)
+ #:autoload (gnu packages) (fold-packages)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-37) ;; option
+ #:use-module (srfi srfi-71)
+ #:export (guix-index))
+
+(define debug #f)
+
+(define application-version 2)
+
+;; The following schema is the full schema at the `application-version`. It
+;; should be modified according to the development required and
+;; `application-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 `application-version` (for the existing dbs to know what to migrate).
+(define schema-full
+ "
+create table if not exists SchemaVersion (
+ version integer primary key not null,
+ date date,
+ unique (version)
+);
+
+create table if not exists Packages (
+ id integer primary key autoincrement not null,
+ name text not null,
+ version text not null,
+ 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;
+")))
+
+(define (call-with-database file proc)
+ (let ((db (sqlite-open file)))
+ (dynamic-wind
+ (lambda () #t)
+ (lambda () (proc db))
+ (lambda () (sqlite-close db)))))
+
+(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)
+VALUES (:version, CURRENT_TIMESTAMP);"
+ #:cache? #t))
+ (sqlite-exec db "begin immediate;")
+ (sqlite-bind-arguments stmt-insert-version #:version version)
+ (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 (insert-files db package version directories)
+ "Insert files from DIRECTORIES as belonging to PACKAGE at VERSION."
+ (define stmt-select-package
+ (sqlite-prepare db "\
+SELECT id FROM Packages WHERE name = :name AND version = :version;"
+ #:cache? #t))
+
+ (define stmt-insert-package
+ (sqlite-prepare db "\
+INSERT OR IGNORE INTO Packages(name, version) -- to avoid spurious writes
+VALUES (:name, :version);"
+ #:cache? #t))
+
+ (define stmt-select-directory
+ (sqlite-prepare db "\
+SELECT id FROM Directories WHERE name = :name AND 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;")
+ (sqlite-bind-arguments stmt-insert-package
+ #:name package
+ #:version version)
+ (sqlite-fold (const #t) #t stmt-insert-package)
+
+ (sqlite-bind-arguments stmt-select-package
+ #:name package
+ #:version version)
+ (match (sqlite-fold cons '() stmt-select-package)
+ ((#(package-id))
+ (when debug
+ (format #t "(pkg, version, pkg-id): (~a, ~a, ~a)"
+ package version package-id)
+ (pk 'package package-id package))
+ (for-each (lambda (directory)
+ (define (strip file)
+ (string-drop file (+ (string-length directory) 1)))
+
+ (sqlite-reset stmt-insert-directory)
+ (sqlite-bind-arguments stmt-insert-directory
+ #:name directory
+ #:package package-id)
+ (sqlite-fold (const #t) #t stmt-insert-directory)
+
+ (sqlite-reset stmt-select-directory)
+ (sqlite-bind-arguments stmt-select-directory
+ #:name directory
+ #:package package-id)
+ (match (sqlite-fold cons '() stmt-select-directory)
+ ((#(directory-id))
+ (when debug
+ (format #t "(name, package, dir-id): (~a, ~a, ~a)\n"
+ directory package-id directory-id))
+ (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;"))
+
+\f
+;;;
+;;; Indexing from local packages.
+;;;
+
+(define (insert-package db package)
+ "Insert all the files of PACKAGE into DB."
+ (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)
+ directories))
+ (return #t)))))
+
+(define (insert-packages-with-progress db packages insert-package-fn)
+ "Insert PACKAGES into DB with progress bar report."
+ (let* ((nb-packages (length packages))
+ (prefix (format #f "Registering ~a packages" nb-packages))
+ (progress (progress-reporter/bar nb-packages prefix)))
+ (call-with-progress-reporter progress
+ (lambda (report)
+ (for-each (lambda (package)
+ (insert-package-fn db package)
+ (report))
+ packages)))))
+
+\f
+;;;
+;;; 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-item entry)))) ;FIXME: outputs?
+
+(define (index-packages-from-manifests-with-db db-pathname)
+ "Index packages entries into DB-PATHNAME from the system manifests."
+ (call-with-database db-pathname
+ (lambda (db)
+ (let ((entries (profiles->manifest-entries (all-profiles))))
+ (insert-packages-with-progress db entries insert-manifest-entry)))))
+
+\f
+;;;
+;;; Search.
+;;;
+
+(define-record-type <package-match>
+ (package-match name version file)
+ package-match?
+ (name package-match-name)
+ (version package-match-version)
+ (file package-match-file))
+
+(define (matching-packages db file)
+ "Return unique <package-match> corresponding to packages containing FILE."
+ (define lookup-stmt
+ (sqlite-prepare db "\
+SELECT Packages.name, Packages.version, Directories.name, Files.name
+FROM Packages
+INNER JOIN Files, Directories
+ON files.basename = :file
+ AND directories.id = files.directory
+ AND packages.id = directories.package;"))
+
+ (sqlite-bind-arguments lookup-stmt #:file file)
+ (sqlite-fold (lambda (result lst)
+ (match result
+ (#(package version directory file)
+ (cons (package-match package version
+ (string-append directory "/" file))
+ lst))))
+ '() lookup-stmt))
+
+\f
+
+;;;
+;;; CLI
+;;;
+
+(define (index-packages-from-store-with-db db-pathname)
+ "Index local store packages using db at location DB-PATHNAME."
+ (call-with-database db-pathname
+ (lambda (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))))
+ (index-packages-from-store db))))
+
+(define (matching-packages-with-db db-pathname file)
+ "Compute list of packages referencing FILE using db at DB-PATHNAME."
+ (call-with-database db-pathname
+ (lambda (db)
+ (matching-packages db file))))
+
+(define (read-version-from-db db-pathname)
+ (call-with-database db-pathname
+ (lambda (db) (read-version db))))
+
+(define (migrate-schema-to-version db-pathname)
+ (call-with-database db-pathname
+ (lambda (db)
+ (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* ((current-db-version (read-version db))
+ (next-db-version (+ 1 current-db-version)))
+ (when (< current-db-version application-version)
+ ;; when the current db version is older than the current application
+ (let ((schema-migration-at-version (assoc-ref schema-to-migrate next-db-version)))
+ (when schema-migration-at-version
+ ;; migrate the schema to the next version (if it exists)
+ (sqlite-exec db schema-migration-at-version)
+ ;; insert current version
+ (insert-version db next-db-version)
+ ;; iterate over the next migration if any
+ (migrate-schema-to-version db))))))
+ (lambda (key . arg)
+ ;; exception handler in case failure to read an inexisting db
+ ;; Fallback to boostrap the schema
+ (sqlite-exec db schema-full)
+ (insert-version db application-version))))))
+
+(define (print-matching-results matches)
+ "Print the MATCHES matching results."
+ (for-each (lambda (result)
+ (format #t "~20a ~a~%"
+ (string-append (package-match-name result)
+ "@" (package-match-version result))
+ (package-match-file result)))
+ matches))
+
+(define default-db-path
+ (string-append (cache-directory #:ensure? #f)
+ "/index/db.sqlite"))
+
+(define (show-help)
+ (display (G_ "Usage: guix index [OPTIONS...] [search FILE...]
+Without argument, indexes (package, file) relationships from the machine.
+This allows indexation with 2 methods, out of the local:
+
+- manifests: This is the fastest implementation with the caveat of indexing
+less packages. That'd be typically the use case of user local indexation.
+
+- store: This is slowest implementation. It discusses with the store
+daemon. That'd be typically the use case of building the largest db in one of
+the build farm node.
+
+With 'search FILE', search for packages installing FILE.\n
+Note: Internal cache is located at ~/.cache/guix/index/db.sqlite by default.
+See --db-path for customization.\n"))
+ (newline)
+ (display (G_ "The valid values for OPTIONS are:"))
+ (newline)
+ (display (G_ "
+ -h, --help Display this help and exit"))
+ (display (G_ "
+ -V, --version Display version information and exit"))
+ (display (G_ "
+ --db-path=DIR Change default location of the cache db"))
+ (newline)
+ (display (G_ "
+ --method=METH Change default indexation method. By default it uses the
+ local \"manifests\" (faster). It can also uses the local
+ \"store\" (slower, typically on the farm build ci)."))
+ (newline)
+ (display (G_ "The valid values for ARGS are:"))
+ (newline)
+ (display (G_ "
+ search FILE Search for packages installing the FILE (from cache db)"))
+ (newline)
+ (display (G_ "
+ <EMPTY> Without any argument, it index packages. This fills in the
+ db cache using whatever indexation method is defined."))
+ (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)
+ (catch 'sqlite-error
+ (lambda ()
+ (let ((db-path (assoc-ref result 'db-path)))
+ (simple-format
+ #t
+ "Extension local cache database:\n- path: ~a\n- version: ~a\n\n"
+ db-path (read-version-from-db db-path))))
+ (lambda (key . arg) 'no-db-yet-so-nothing-to-display))
+ (show-version-and-exit "guix index")))
+ ;; index data out of the method (store or package)
+ (option '(#\d "db-path") #f #t
+ (lambda (opt name arg result)
+ (when debug
+ (format #t "%options: --db-path: opt ~a\n" opt)
+ (format #t "%options: --db-path: name ~a\n" name)
+ (format #t "%options: --db-path: arg ~a\n" arg)
+ (format #t "%options: --db-path: result ~a\n" result))
+ (alist-cons 'db-path arg
+ (alist-delete 'db-path result))))
+
+ ;; index data out of the method (store or package)
+ (option '(#\m "method") #f #t
+ (lambda (opt name arg result)
+ (when debug
+ (format #t "%options: --method: opt ~a\n" opt)
+ (format #t "%options: --method: name ~a\n" name)
+ (format #t "%options: --method: arg ~a\n" arg)
+ (format #t "%options: --method: result ~a\n" result))
+ (match arg
+ ((or "manifests" "store")
+ (alist-cons 'with-method arg
+ (alist-delete 'with-method result)))
+ (_
+ (G_ "guix index: Wrong indexation method, either manifests
+ (fast) or store (slow)~%")))))))
+
+(define %default-options
+ `((db-path . ,default-db-path)
+ (with-method . "manifests")))
+
+(define-command (guix-index . args)
+ (category extension)
+ (synopsis "Index packages to search package for a given filename")
+
+ (define (parse-sub-command arg result)
+ ;; Parse sub-command ARG and augment RESULT accordingly.
+ (when debug
+ (format #t "parse-sub-command: arg: ~a\n" arg)
+ (format #t "parse-sub-command: result: ~a\n" result)
+ (format #t "parse-sub-command: (assoc-ref result 'action): ~a\n" (assoc-ref result 'action))
+ (format #t "parse-sub-command: (assoc-ref result 'argument): ~a\n" (assoc-ref result 'argument)))
+ (if (assoc-ref result 'action)
+ (alist-cons 'argument arg result)
+ (let ((action (string->symbol arg)))
+ (case action
+ ((search)
+ (alist-cons 'action action result))
+ (else (leave (G_ "~a: unknown action~%") action))))))
+
+ (define (match-pair car)
+ ;; Return a procedure that matches a pair with CAR.
+ (match-lambda
+ ((head . tail)
+ (and (eq? car head) tail))
+ (_ #f)))
+
+ (define (option-arguments opts)
+ ;; Extract the plain arguments from OPTS.
+ (let* ((args (reverse (filter-map (match-pair 'argument) opts)))
+ (count (length args))
+ (action (or (assoc-ref opts 'action) 'index)))
+
+ (when debug
+ (format #t "option-arguments: args: ~a\n" args)
+ (format #t "option-arguments: count: ~a\n" count)
+ (format #t "option-arguments: action: ~a\n" action))
+
+ (define (fail)
+ (leave (G_ "wrong number of arguments for action '~a'~%")
+ action))
+
+ (unless action
+ (format (current-error-port)
+ (G_ "guix index: missing command name~%"))
+ (format (current-error-port)
+ (G_ "Try 'guix index --help' for more information.~%"))
+ (exit 1))
+ (alist-cons 'argument (string-concatenate args)
+ (alist-delete 'argument
+ (alist-cons 'action action
+ (alist-delete 'action opts))))))
+
+ (with-error-handling
+ (let* ((opts (parse-command-line args %options
+ (list %default-options)
+ #:argument-handler
+ parse-sub-command))
+ (args (option-arguments opts))
+ (action (assoc-ref args 'action))
+ (db-path (assoc-ref args 'db-path))
+ (with-method (assoc-ref args 'with-method)))
+ (when debug
+ (format #t "main: opts: ~a\n" opts)
+ (format #t "main: args: ~a\n" args)
+ (format #t "main: action: ~a\n" action)
+ (format #t "main: db-path: ~a\n" db-path)
+ (format #t "main: with-method: ~a\n" with-method))
+
+ (match action
+ ('search
+ (unless (file-exists? db-path)
+ (format (current-error-port)
+ (G_ "guix index: The local cache db does not exist yet.
+You need to index packages first.\nTry 'guix index --help' for more information.~%"))
+ (exit 1))
+ (let* ((file (assoc-ref args 'argument))
+ (matches (matching-packages-with-db db-path file)))
+ (print-matching-results matches)
+ (exit (pair? matches))))
+ ('index
+ (let ((db-dirpath (dirname db-path)))
+ (unless (file-exists? db-dirpath)
+ (mkdir db-dirpath)))
+ ;; Migrate/initialize db to schema at version application-version
+ (migrate-schema-to-version db-path)
+ ;; Finally index packages
+ (if (string= with-method "manifests")
+ (index-packages-from-manifests-with-db db-path)
+ (index-packages-from-store-with-db db-path)))))))
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 8ff8182a79..9a6ddae271 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -69,7 +69,7 @@ (define-module (guix scripts home)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-35)
- #:use-module (srfi srfi-37)
+ #:use-module ((srfi srfi-37) #:select (option))
#:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:export (guix-home))
--
2.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: 0002-scripts-index-Transform-guix-index-extension-into-a-.patch --]
[-- Type: text/x-diff, Size: 1432 bytes --]
From 434b27de6227f5077505c1a1688a6ae500bbe56f Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Tue, 20 Dec 2022 16:05:50 +0100
Subject: [PATCH core-updates 2/6] scripts-index: Transform `guix index`
extension into a Guix script
---
guix/{extensions => scripts}/index.scm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
rename guix/{extensions => scripts}/index.scm (99%)
diff --git a/guix/extensions/index.scm b/guix/scripts/index.scm
similarity index 99%
rename from guix/extensions/index.scm
rename to guix/scripts/index.scm
index d9894b213e..8d68a63847 100644
--- a/guix/extensions/index.scm
+++ b/guix/scripts/index.scm
@@ -16,7 +16,7 @@
;;; 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 extensions index)
+(define-module (guix scripts index)
#:use-module ((guix i18n) #:select (G_))
#:use-module ((guix ui) #:select (show-version-and-exit
show-bug-report-information
@@ -484,7 +484,7 @@ (define %default-options
(with-method . "manifests")))
(define-command (guix-index . args)
- (category extension)
+ (category packaging)
(synopsis "Index packages to search package for a given filename")
(define (parse-sub-command arg result)
--
2.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.4: 0003-scripts-index-Store-outputs-alongside-packages.patch --]
[-- Type: text/x-diff, Size: 13409 bytes --]
From 8799fcfb9f6238abe0e19ce650ee7f1e2b7e0d90 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Thu, 22 Dec 2022 15:53:43 +0100
Subject: [PATCH core-updates 3/6] scripts-index: Store outputs alongside
packages
---
guix/scripts/index.scm | 207 ++++++++++++++++++++++-------------------
1 file changed, 112 insertions(+), 95 deletions(-)
diff --git a/guix/scripts/index.scm b/guix/scripts/index.scm
index 8d68a63847..d1478042ab 100644
--- a/guix/scripts/index.scm
+++ b/guix/scripts/index.scm
@@ -50,7 +50,7 @@ (define-module (guix scripts index)
(define debug #f)
-(define application-version 2)
+(define application-version 3)
;; The following schema is the full schema at the `application-version`. It
;; should be modified according to the development required and
@@ -70,6 +70,7 @@ (define schema-full
id integer primary key autoincrement not null,
name text not null,
version text not null,
+ output text,
unique (name, version) -- add uniqueness constraint
);
@@ -102,6 +103,10 @@ (define schema-to-migrate '((1 . "
(2 . "
alter table SchemaVersion
add column date date;
+")
+ (3 . "
+alter table Packages
+add column output text;
")))
(define (call-with-database file proc)
@@ -133,85 +138,90 @@ (define stmt-select-version (sqlite-prepare db "\
((#(version))
version)))
-(define (insert-files db package version directories)
- "Insert files from DIRECTORIES as belonging to PACKAGE at VERSION."
- (define stmt-select-package
- (sqlite-prepare db "\
-SELECT id FROM Packages WHERE name = :name AND version = :version;"
- #:cache? #t))
-
- (define stmt-insert-package
- (sqlite-prepare db "\
-INSERT OR IGNORE INTO Packages(name, version) -- to avoid spurious writes
-VALUES (:name, :version);"
- #:cache? #t))
-
- (define stmt-select-directory
- (sqlite-prepare db "\
+(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 REPLACE INTO Packages(name, version, output)
+VALUES (:name, :version, :output);"
+ #:cache? #t))
+
+ (define stmt-select-directory
+ (sqlite-prepare db "\
SELECT id FROM Directories WHERE name = :name AND package = :package;"
- #:cache? #t))
+ #:cache? #t))
- (define stmt-insert-directory
- (sqlite-prepare db "\
+ (define stmt-insert-directory
+ (sqlite-prepare db "\
INSERT OR IGNORE INTO Directories(name, package) -- to avoid spurious writes
VALUES (:name, :package);"
- #:cache? #t))
+ #:cache? #t))
- (define stmt-insert-file
- (sqlite-prepare db "\
+ (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;")
- (sqlite-bind-arguments stmt-insert-package
- #:name package
- #:version version)
- (sqlite-fold (const #t) #t stmt-insert-package)
-
- (sqlite-bind-arguments stmt-select-package
- #:name package
- #:version version)
- (match (sqlite-fold cons '() stmt-select-package)
- ((#(package-id))
- (when debug
- (format #t "(pkg, version, pkg-id): (~a, ~a, ~a)"
- package version package-id)
- (pk 'package package-id package))
- (for-each (lambda (directory)
- (define (strip file)
- (string-drop file (+ (string-length directory) 1)))
-
- (sqlite-reset stmt-insert-directory)
- (sqlite-bind-arguments stmt-insert-directory
- #:name directory
- #:package package-id)
- (sqlite-fold (const #t) #t stmt-insert-directory)
-
- (sqlite-reset stmt-select-directory)
- (sqlite-bind-arguments stmt-select-directory
- #:name directory
- #:package package-id)
- (match (sqlite-fold cons '() stmt-select-directory)
- ((#(directory-id))
- (when debug
- (format #t "(name, package, dir-id): (~a, ~a, ~a)\n"
- directory package-id directory-id))
- (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;"))
+ #:cache? #t))
+
+ (sqlite-exec db "begin immediate;")
+ ;; 1 record per output
+ (for-each (lambda (output)
+ (let ((out (if (string=? "out" output) "" output)))
+ (sqlite-reset stmt-insert-package)
+ (sqlite-bind-arguments stmt-insert-package
+ #:name package
+ #:version version
+ #:output out)
+ (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))
+ (when debug
+ (format #t "(pkg, version, pkg-id): (~a, ~a, ~a)"
+ package version package-id)
+ (pk 'package package-id package))
+ (for-each (lambda (directory)
+ (define (strip file)
+ (string-drop file (+ (string-length directory) 1)))
+
+ (sqlite-reset stmt-insert-directory)
+ (sqlite-bind-arguments stmt-insert-directory
+ #:name directory
+ #:package package-id)
+ (sqlite-fold (const #t) #t stmt-insert-directory)
+
+ (sqlite-reset stmt-select-directory)
+ (sqlite-bind-arguments stmt-select-directory
+ #:name directory
+ #:package package-id)
+ (match (sqlite-fold cons '() stmt-select-directory)
+ ((#(directory-id))
+ (when debug
+ (format #t "(name, package, dir-id): (~a, ~a, ~a)\n"
+ directory package-id directory-id))
+ (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;"))
\f
;;;
@@ -224,8 +234,9 @@ (define (insert-package db package)
(match (derivation->output-paths drv)
(((labels . directories) ...)
(when (every file-exists? directories)
- (insert-files db (package-name package) (package-version package)
- 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-fn)
@@ -283,6 +294,7 @@ (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-pathname)
@@ -298,28 +310,29 @@ (define (index-packages-from-manifests-with-db db-pathname)
;;;
(define-record-type <package-match>
- (package-match name version file)
+ (package-match name version output file)
package-match?
- (name package-match-name)
- (version package-match-version)
- (file package-match-file))
+ (name package-match-name)
+ (version package-match-version)
+ (output package-match-output)
+ (file package-match-file))
(define (matching-packages db file)
"Return unique <package-match> corresponding to packages containing FILE."
(define lookup-stmt
(sqlite-prepare db "\
-SELECT Packages.name, Packages.version, Directories.name, Files.name
-FROM Packages
-INNER JOIN Files, Directories
-ON files.basename = :file
- AND directories.id = files.directory
- AND packages.id = directories.package;"))
+SELECT p.name, p.version, p.output, d.name, f.name
+FROM Packages p
+INNER JOIN Files f, Directories d
+ON f.basename = :file
+ AND d.id = f.directory
+ AND p.id = d.package;"))
(sqlite-bind-arguments lookup-stmt #:file file)
(sqlite-fold (lambda (result lst)
(match result
- (#(package version directory file)
- (cons (package-match package version
+ (#(package version output directory file)
+ (cons (package-match package version output
(string-append directory "/" file))
lst))))
'() lookup-stmt))
@@ -346,14 +359,12 @@ (define (insert-package-from-store db package)
(not (package-superseded package))
(supported-package? package))))))
(insert-packages-with-progress
- db packages insert-package-from-store))))
- (index-packages-from-store db))))
+ db packages insert-package-from-store)))))))
(define (matching-packages-with-db db-pathname file)
"Compute list of packages referencing FILE using db at DB-PATHNAME."
(call-with-database db-pathname
- (lambda (db)
- (matching-packages db file))))
+ (lambda (db) (matching-packages db file))))
(define (read-version-from-db db-pathname)
(call-with-database db-pathname
@@ -387,10 +398,16 @@ (define (migrate-schema-to-version db-pathname)
(define (print-matching-results matches)
"Print the MATCHES matching results."
(for-each (lambda (result)
- (format #t "~20a ~a~%"
- (string-append (package-match-name result)
- "@" (package-match-version result))
- (package-match-file 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
+ (if (string-null? output)
+ ""
+ (string-append ":" output)))
+ file)))
matches))
(define default-db-path
--
2.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.5: 0004-Makefile.am-Reference-new-script-to-compile.patch --]
[-- Type: text/x-diff, Size: 987 bytes --]
From ecea57fd4b46a8da5b78db17ceb7d8225a9e68e6 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Fri, 24 Feb 2023 13:54:05 +0100
Subject: [PATCH core-updates 4/6] Makefile.am: Reference new script to compile
---
Makefile.am | 2 ++
1 file changed, 2 insertions(+)
diff --git a/Makefile.am b/Makefile.am
index 23b939b674..6edd5eb900 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -302,6 +302,7 @@ MODULES = \
guix/scripts/archive.scm \
guix/scripts/import.scm \
guix/scripts/package.scm \
+ guix/scripts/index.scm \
guix/scripts/install.scm \
guix/scripts/remove.scm \
guix/scripts/upgrade.scm \
@@ -589,6 +590,7 @@ SH_TESTS = \
tests/guix-gc.sh \
tests/guix-git-authenticate.sh \
tests/guix-hash.sh \
+ tests/guix-index.sh \
tests/guix-pack.sh \
tests/guix-pack-localstatedir.sh \
tests/guix-pack-relocatable.sh \
--
2.36.1
[-- Attachment #1.6: 0005-Bootstrap-tests-for-guix-index-subcommand.patch --]
[-- Type: text/x-diff, Size: 3995 bytes --]
From ae756e5add599fe0bb07547b5ff43ffa22f47da0 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Fri, 24 Feb 2023 13:54:17 +0100
Subject: [PATCH core-updates 5/6] Bootstrap tests for guix index subcommand
---
guix/scripts/index.scm | 4 +++
tests/guix-index.sh | 73 ++++++++++++++++++++++++++++++++++++++++++
2 files changed, 77 insertions(+)
create mode 100755 tests/guix-index.sh
diff --git a/guix/scripts/index.scm b/guix/scripts/index.scm
index d1478042ab..adf0f31269 100644
--- a/guix/scripts/index.scm
+++ b/guix/scripts/index.scm
@@ -555,6 +555,10 @@ (define (fail)
(with-error-handling
(let* ((opts (parse-command-line args %options
(list %default-options)
+ ;; ignore $GUIX_BUILD_OPTIONS
+ ;; otherwise, subcommand is not
+ ;; detected in the tests context
+ #:build-options? #f
#:argument-handler
parse-sub-command))
(args (option-arguments opts))
diff --git a/tests/guix-index.sh b/tests/guix-index.sh
new file mode 100755
index 0000000000..2c21d45a6b
--- /dev/null
+++ b/tests/guix-index.sh
@@ -0,0 +1,73 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2013, 2014, 2015, 2019, 2020, 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 index' command-line utility.
+#
+
+set -x
+
+tmpdir="guix-index-$$"
+trap 'rm -rf "$tmpdir"' EXIT
+
+guix index --version
+
+# Basic application to install and lookup through the index subcommand
+APPLICATION=guile-bootstrap
+
+# The subcommand exposes two indexation methods so far:
+# - manifests: fast and less exhaustive
+# - store: slow, exhaustive
+
+# In the following tests, we will store in 2 different dbs for both indexation
+# methods
+tmpdb_manifests="$tmpdir/manifests/db.sqlite"
+tmpdb_store="$tmpdir/store/db.sqlite"
+
+echo "### Preparing db locations for both indexation methods"
+mkdir -p `dirname $tmpdb_manifests` `dirname $tmpdb_store`
+
+cmd_manifests="guix index --db-path=$tmpdb_manifests --method=manifests"
+cmd_store="guix index --db-path=$tmpdb_store --method=store"
+
+echo "### Lookup without any db should fail"
+! $cmd_manifests search "$APPLICATION"
+! $cmd_store search "$APPLICATION"
+
+echo "### Initializing db with bare guix store should work"
+$cmd_manifests
+# ! $cmd_store
+
+echo "### lookup without anything in db should yield no result"
+! test `$cmd_manifests search "$APPLICATION"`
+# ! test `$cmd_store search "$APPLICATION"`
+
+echo "### Add some package to the temporary store"
+guix package --bootstrap \
+ --install $APPLICATION \
+ --profile=$tmpdir/profile
+
+echo "### Both both indexation call should work"
+# Testing indexation should work for both method
+test `$cmd_manifests`
+# test `$cmd_store`
+
+echo "### lookup indexed '$APPLICATION' should yield result"
+
+test `$cmd_manifests search "$APPLICATION"`
+# test `$cmd_store search "$APPLICATION"`
--
2.36.1
[-- Attachment #1.7: 0006-Allow-gcroot-function-to-exceptionally-ignore-error.patch --]
[-- Type: text/x-diff, Size: 2865 bytes --]
From 372b2b9660b8293eebd6280bb46a4ec07d4192a7 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Mon, 13 Mar 2023 13:52:38 +0100
Subject: [PATCH core-updates 6/6] Allow gcroot function to exceptionally
ignore error
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Co-authored with Ludovic Courtès <ludo@gnu.org>
---
guix/store/roots.scm | 10 +++++++++-
tests/store-roots.scm | 7 ++++++-
2 files changed, 15 insertions(+), 2 deletions(-)
diff --git a/guix/store/roots.scm b/guix/store/roots.scm
index 222f69c5c0..c2b15c33f0 100644
--- a/guix/store/roots.scm
+++ b/guix/store/roots.scm
@@ -105,7 +105,15 @@ (define canonical-root
(map (match-lambda
((file . properties)
(cons (scope file) properties)))
- (scandir* directory regular?)))))
+ (catch 'system-error
+ (lambda ()
+ (scandir* directory regular?))
+ (lambda args
+ (if (= ENOENT
+ (system-error-errno
+ args))
+ '()
+ (apply throw args))))))))
(loop (append rest (map first sub-directories))
(append (map canonical-root (filter symlink? files))
roots)
diff --git a/tests/store-roots.scm b/tests/store-roots.scm
index 5bcf1bc87e..00a4fe7931 100644
--- a/tests/store-roots.scm
+++ b/tests/store-roots.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,6 +21,7 @@ (define-module (test-store-deduplication)
#:use-module (guix store)
#:use-module (guix store roots)
#:use-module ((guix utils) #:select (call-with-temporary-directory))
+ #:use-module ((guix config) #:select (%state-directory))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64))
@@ -29,6 +30,10 @@ (define %store
(test-begin "store-roots")
+(test-equal "gc-roots, initial"
+ (list (string-append %state-directory "/profiles"))
+ (gc-roots))
+
(test-assert "gc-roots, regular root"
(let* ((item (add-text-to-store %store "something"
(random-text)))
--
2.36.1
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 877 bytes --]
^ permalink raw reply related [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH core-updates 0/6] Add `guix index` subcommand
2023-03-18 16:06 [bug#62264] [PATCH core-updates 0/6] Add `guix index` subcommand Antoine R. Dumont (@ardumont)
2023-03-18 16:57 ` [bug#62264] [PATCH core-updates 1-6/6] " Antoine R. Dumont
@ 2023-04-02 21:57 ` Ludovic Courtès
2023-05-21 21:45 ` Ludovic Courtès
1 sibling, 1 reply; 28+ messages in thread
From: Ludovic Courtès @ 2023-04-02 21:57 UTC (permalink / raw)
To: Antoine R. Dumont (@ardumont); +Cc: 62264
Hi Antoine,
"Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
skribis:
> Example of an indexation (fast method by default):
>
> $ guix index
> Registering 133 packages ▕█████▎ ▏
>
>
> Example of a search:
>
> $ guix index search sqlite3
> sqlite@3.37.0 /gnu/store/jd6nn2c8ln5flv4vwl7pp1w804w2i9wj-sqlite-3.37.0/bin/sqlite3
> sqlite@3.36.0 /gnu/store/xmzx5mzv4863yw9kmr2ykndgp37p8if0-sqlite-3.36.0/bin/sqlite3
This is really nice! I finally got around to looking at the patches.
The final version will be a single patch that adds code, tests, and
documentation.
I squashed the ‘guix index’ patches you posted, followed up with
individual changes on top of that (those will have to be squashed
eventually), and pushed the result in the ‘wip-guix-index’ branch.
Lemme know what you think!
Good news is “make check TESTS=tests/guix-index.sh” passes. I disabled
tests for the ‘store’ method by default because it’s too expensive (it
would take several minutes with my SSD).
There were other things I wanted to fiddle with but I ran out of time
:-) so I’ll take another look later.
The main missing bit is a new node in the manual documenting it.
Perhaps one feature that would be nice to have before we publish is
pruning of database entries, so it doesn’t grow endlessly, but I’m not
sure how to do that (based on whether a Directory entry actually
exists?).
Thanks!
Ludo’.
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH core-updates 0/6] Add `guix index` subcommand
2023-04-02 21:57 ` [bug#62264] [PATCH core-updates 0/6] " Ludovic Courtès
@ 2023-05-21 21:45 ` Ludovic Courtès
2023-05-22 16:53 ` Simon Tournier
2023-06-04 22:25 ` Ludovic Courtès
0 siblings, 2 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-05-21 21:45 UTC (permalink / raw)
To: Antoine R. Dumont (@ardumont); +Cc: 62264
Hello!
Ludovic Courtès <ludo@gnu.org> skribis:
> I squashed the ‘guix index’ patches you posted, followed up with
> individual changes on top of that (those will have to be squashed
> eventually), and pushed the result in the ‘wip-guix-index’ branch.
> Lemme know what you think!
I’ve pushed additional changes. There are a few more things I’d like to
do before we can merge it:
- [ ] 'guix index' renamed to 'guix locate'
- [ ] 'search' action removed; option added to force reindexing
- [ ] warning printed when database is too old
- [ ] start anew when database is very old
- [ ] documentation written
- [ ] '--help' output made more concise
We can think about fetching databases in a second iteration.
Ludo’.
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH core-updates 0/6] Add `guix index` subcommand
2023-05-21 21:45 ` Ludovic Courtès
@ 2023-05-22 16:53 ` Simon Tournier
2023-05-24 14:40 ` Ludovic Courtès
2023-06-04 22:25 ` Ludovic Courtès
1 sibling, 1 reply; 28+ messages in thread
From: Simon Tournier @ 2023-05-22 16:53 UTC (permalink / raw)
To: Ludovic Courtès, Antoine R. Dumont (@ardumont); +Cc: 62264
Hi,
On dim., 21 mai 2023 at 23:45, Ludovic Courtès <ludo@gnu.org> wrote:
> - [ ] 'guix index' renamed to 'guix locate'
Well, I have some patches that rename to “guix file”. :-)
Well, ’guix locale’ appears to me also fine.
> - [ ] 'search' action removed; option added to force reindexing
I have an unpolished stuff that do:
guix file --index=TYPE
guix file foo bar
Somehow, “guix file <terms>” the default action (= search). And then
some action with --action (as index or else).
> - [ ] warning printed when database is too old
> - [ ] start anew when database is very old
> - [ ] documentation written
I have started… but I am not very far. :-)
> - [ ] '--help' output made more concise
Maybe also remove some “debug” code, no?
Cheers,
simon
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH core-updates 0/6] Add `guix index` subcommand
2023-05-22 16:53 ` Simon Tournier
@ 2023-05-24 14:40 ` Ludovic Courtès
2023-05-25 16:20 ` Simon Tournier
0 siblings, 1 reply; 28+ messages in thread
From: Ludovic Courtès @ 2023-05-24 14:40 UTC (permalink / raw)
To: Simon Tournier; +Cc: Antoine R. Dumont (@ardumont), 62264
Hi,
Simon Tournier <zimon.toutoune@gmail.com> skribis:
> On dim., 21 mai 2023 at 23:45, Ludovic Courtès <ludo@gnu.org> wrote:
>
>> - [ ] 'guix index' renamed to 'guix locate'
>
> Well, I have some patches that rename to “guix file”. :-)
>
> Well, ’guix locale’ appears to me also fine.
“locate” sounds better to me, notably because it’s a verb.
>> - [ ] 'search' action removed; option added to force reindexing
>
> I have an unpolished stuff that do:
>
> guix file --index=TYPE
> guix file foo bar
>
> Somehow, “guix file <terms>” the default action (= search). And then
> some action with --action (as index or else).
>
>> - [ ] warning printed when database is too old
>> - [ ] start anew when database is very old
>> - [ ] documentation written
>
> I have started… but I am not very far. :-)
Could you share what you have?
(I didn’t expect feedback so I thought I’d end up hack on the stuff
head-down. Now we need to synchronize. :-))
>> - [ ] '--help' output made more concise
>
> Maybe also remove some “debug” code, no?
Done already.
Thanks!
Ludo’.
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH core-updates 0/6] Add `guix index` subcommand
2023-05-24 14:40 ` Ludovic Courtès
@ 2023-05-25 16:20 ` Simon Tournier
2023-05-26 16:44 ` Ludovic Courtès
0 siblings, 1 reply; 28+ messages in thread
From: Simon Tournier @ 2023-05-25 16:20 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Antoine R. Dumont (@ardumont), 62264
Hi Ludo,
On mer., 24 mai 2023 at 16:40, Ludovic Courtès <ludo@gnu.org> wrote:
>> Well, I have some patches that rename to “guix file”. :-)
>>
>> Well, ’guix locale’ appears to me also fine.
I was meaning ’locate’ not ’locale’, sorry for the typo.
> “locate” sounds better to me, notably because it’s a verb.
Yeah, ’locate’ is better. Especially when one knows about the good ol’
locate program. ;-)
>>> - [ ] 'search' action removed; option added to force reindexing
>>
>> I have an unpolished stuff that do:
>>
>> guix file --index=TYPE
>> guix file foo bar
>>
>> Somehow, “guix file <terms>” the default action (= search). And then
>> some action with --action (as index or else).
>>
>>> - [ ] warning printed when database is too old
>>> - [ ] start anew when database is very old
>>> - [ ] documentation written
>>
>> I have started… but I am not very far. :-)
>
> Could you share what you have?
I will. Do you prefer a patch? Or that I push to the branch?
> (I didn’t expect feedback so I thought I’d end up hack on the stuff
> head-down. Now we need to synchronize. :-))
There is much to synchronize because I did few. :-)
My concerns were:
1. about the name “guix index” and now it’s fixed by “guix locate” ;-)
and 2. about the CLI; the default “guix locate <term>” should be the
search action. The update action should be triggered with an option as
“-i/--index=”.
Cheers,
simon
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH core-updates 0/6] Add `guix index` subcommand
2023-05-25 16:20 ` Simon Tournier
@ 2023-05-26 16:44 ` Ludovic Courtès
0 siblings, 0 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-05-26 16:44 UTC (permalink / raw)
To: Simon Tournier; +Cc: Antoine R. Dumont (@ardumont), 62264
Hi,
Simon Tournier <zimon.toutoune@gmail.com> skribis:
> I will. Do you prefer a patch? Or that I push to the branch?
Patch, please!
> My concerns were:
>
> 1. about the name “guix index” and now it’s fixed by “guix locate” ;-)
>
> and 2. about the CLI; the default “guix locate <term>” should be the
> search action. The update action should be triggered with an option as
> “-i/--index=”.
Ah yes, agreed!
Ludo’.
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH core-updates 0/6] Add `guix index` subcommand
2023-05-21 21:45 ` Ludovic Courtès
2023-05-22 16:53 ` Simon Tournier
@ 2023-06-04 22:25 ` Ludovic Courtès
2023-06-07 22:09 ` [bug#62264] [PATCH v2 0/3] Add 'guix locate' Ludovic Courtès
` (3 more replies)
1 sibling, 4 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-04 22:25 UTC (permalink / raw)
To: Antoine R. Dumont (@ardumont); +Cc: 62264
Ludovic Courtès <ludo@gnu.org> skribis:
> I’ve pushed additional changes. There are a few more things I’d like to
> do before we can merge it:
>
> - [ ] 'guix index' renamed to 'guix locate'
> - [ ] 'search' action removed; option added to force reindexing
> - [ ] warning printed when database is too old
> - [ ] start anew when database is very old
> - [ ] documentation written
> - [ ] '--help' output made more concise
Hi! I’m pretty much done with the items above (I’ve pushed
‘wip-guix-index’ again). I’ll take another look and send the final
patch here.
Feedback welcome!
Ludo’.
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v2 0/3] Add 'guix locate'
2023-06-04 22:25 ` Ludovic Courtès
@ 2023-06-07 22:09 ` Ludovic Courtès
2023-06-09 3:57 ` Ryan Prior
2023-06-07 22:09 ` [bug#62264] [PATCH v2 1/3] store: Tolerate non-existent GC root directories Ludovic Courtès
` (2 subsequent siblings)
3 siblings, 1 reply; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-07 22:09 UTC (permalink / raw)
To: 62264; +Cc: Ludovic Courtès, Antoine R. Dumont, guix-devel
Hello!
Here is the “camera-ready” version of the new ‘guix locate’ command
(formerly ‘guix index’) that Antoine and myself have worked on.
I think it’s ready to go.
This version relies only on local knowledge, which means you can
only find packages already in your store. In a future iteration,
we’ll add an optional mechanism to download the database from
elsewhere.
Thoughts?
Ludo’.
Ludovic Courtès (3):
store: Tolerate non-existent GC root directories.
Add 'guix locate'.
DRAFT news: Add entry for 'guix locate'.
Makefile.am | 2 +
doc/guix.texi | 118 ++++++++
etc/news.scm | 17 ++
guix/scripts/locate.scm | 657 ++++++++++++++++++++++++++++++++++++++++
guix/store/roots.scm | 12 +-
po/guix/POTFILES.in | 1 +
tests/guix-locate.sh | 72 +++++
tests/store-roots.scm | 18 +-
8 files changed, 892 insertions(+), 5 deletions(-)
create mode 100644 guix/scripts/locate.scm
create mode 100755 tests/guix-locate.sh
base-commit: e8f9fb3e03ea8fee0e13f13706a6b16414f74a7b
--
2.40.1
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v2 1/3] store: Tolerate non-existent GC root directories.
2023-06-04 22:25 ` Ludovic Courtès
2023-06-07 22:09 ` [bug#62264] [PATCH v2 0/3] Add 'guix locate' Ludovic Courtès
@ 2023-06-07 22:09 ` Ludovic Courtès
2023-06-07 22:09 ` [bug#62264] [PATCH v2 2/3] Add 'guix locate' Ludovic Courtès
2023-06-07 22:09 ` [bug#62264] [PATCH v2 3/3] DRAFT news: Add entry for 'guix locate' Ludovic Courtès
3 siblings, 0 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-07 22:09 UTC (permalink / raw)
To: 62264; +Cc: Ludovic Courtès
* guix/store/roots.scm (gc-roots): Wrap 'scandir*' call in 'catch'.
* tests/store-roots.scm ("gc-roots, initial"): New test. Move
'open-connection' call below.
---
guix/store/roots.scm | 12 ++++++++++--
tests/store-roots.scm | 18 +++++++++++++++---
2 files changed, 25 insertions(+), 5 deletions(-)
diff --git a/guix/store/roots.scm b/guix/store/roots.scm
index 222f69c5c0..6b949b5a86 100644
--- a/guix/store/roots.scm
+++ b/guix/store/roots.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2014, 2017, 2019, 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -105,7 +105,15 @@ (define (gc-roots)
(map (match-lambda
((file . properties)
(cons (scope file) properties)))
- (scandir* directory regular?)))))
+ (catch 'system-error
+ (lambda ()
+ (scandir* directory regular?))
+ (lambda args
+ (if (= ENOENT
+ (system-error-errno
+ args))
+ '()
+ (apply throw args))))))))
(loop (append rest (map first sub-directories))
(append (map canonical-root (filter symlink? files))
roots)
diff --git a/tests/store-roots.scm b/tests/store-roots.scm
index 5bcf1bc87e..9877987a65 100644
--- a/tests/store-roots.scm
+++ b/tests/store-roots.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,14 +21,26 @@ (define-module (test-store-deduplication)
#:use-module (guix store)
#:use-module (guix store roots)
#:use-module ((guix utils) #:select (call-with-temporary-directory))
+ #:use-module ((guix build utils) #:select (delete-file-recursively))
+ #:use-module ((guix config) #:select (%state-directory))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64))
-(define %store
- (open-connection))
+(define %store #f)
(test-begin "store-roots")
+(test-equal "gc-roots, initial"
+ (list (string-append %state-directory "/profiles"))
+ (begin
+ ;; 'gc-roots' should gracefully handle lack of that directory.
+ (delete-file-recursively (string-append %state-directory "/profiles"))
+ (gc-roots)))
+
+;; The 'open-connection' call below gets guix-daemon to create
+;; %STATE-DIRECTORY/profiles.
+(set! %store (open-connection))
+
(test-assert "gc-roots, regular root"
(let* ((item (add-text-to-store %store "something"
(random-text)))
--
2.40.1
^ permalink raw reply related [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v2 2/3] Add 'guix locate'.
2023-06-04 22:25 ` Ludovic Courtès
2023-06-07 22:09 ` [bug#62264] [PATCH v2 0/3] Add 'guix locate' Ludovic Courtès
2023-06-07 22:09 ` [bug#62264] [PATCH v2 1/3] store: Tolerate non-existent GC root directories Ludovic Courtès
@ 2023-06-07 22:09 ` Ludovic Courtès
2023-06-08 17:27 ` Jelle Licht
2023-06-08 20:59 ` [bug#62264] [PATCH v2 2/3] Add 'guix locate' pelzflorian (Florian Pelz)
2023-06-07 22:09 ` [bug#62264] [PATCH v2 3/3] DRAFT news: Add entry for 'guix locate' Ludovic Courtès
3 siblings, 2 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-07 22:09 UTC (permalink / raw)
To: 62264; +Cc: Antoine R . Dumont, Ludovic Courtès
* 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.
Co-authored-by: Antoine R. Dumont <antoine.romain.dumont@gmail.com>
---
Makefile.am | 2 +
doc/guix.texi | 118 ++++++++
guix/scripts/locate.scm | 657 ++++++++++++++++++++++++++++++++++++++++
po/guix/POTFILES.in | 1 +
tests/guix-locate.sh | 72 +++++
5 files changed, 850 insertions(+)
create mode 100644 guix/scripts/locate.scm
create mode 100755 tests/guix-locate.sh
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 01f4e0105f..2559e89d99 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -258,6 +258,7 @@ Top
* 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 @@ 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.
@@ -4417,6 +4419,122 @@ Packages with Multiple Outputs
guix package}).
+@node Invoking guix locate
+@section Invoking @command{guix locate}
+
+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 Warning
+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
+
+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.
+
+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 --datebase=@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..b5d8671d9c
--- /dev/null
+++ b/guix/scripts/locate.scm
@@ -0,0 +1,657 @@
+;;; 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) ;; option
+ #:use-module (srfi srfi-71)
+ #:export (guix-locate))
+
+(define application-version 3)
+
+;; The following schema is the full schema at the `application-version`. It
+;; should be modified according to the development required and
+;; `application-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 `application-version` (for the existing dbs to know what to migrate).
+(define schema-full
+ "
+create table if not exists SchemaVersion (
+ version integer primary key not null,
+ date date,
+ 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 schema-full)
+ (insert-version db application-version))
+
+ (let ((version (false-if-exception (read-version db))))
+ (cond ((not version)
+ (initialize))
+ ((> version application-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 application-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))))))))
+
+\f
+;;;
+;;; 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)))))
+
+\f
+;;;
+;;; 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)))
+
+
+\f
+;;;
+;;; 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))
+
+\f
+;;;
+;;; 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)))
+
+\f
+;;;
+;;; 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
--
2.40.1
^ permalink raw reply related [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v2 3/3] DRAFT news: Add entry for 'guix locate'.
2023-06-04 22:25 ` Ludovic Courtès
` (2 preceding siblings ...)
2023-06-07 22:09 ` [bug#62264] [PATCH v2 2/3] Add 'guix locate' Ludovic Courtès
@ 2023-06-07 22:09 ` Ludovic Courtès
2023-06-08 21:19 ` pelzflorian (Florian Pelz)
3 siblings, 1 reply; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-07 22:09 UTC (permalink / raw)
To: 62264; +Cc: Ludovic Courtès
* etc/news.scm: Add entry.
---
etc/news.scm | 17 +++++++++++++++++
1 file changed, 17 insertions(+)
diff --git a/etc/news.scm b/etc/news.scm
index 314f0ab352..a93c52e6d0 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -26,6 +26,23 @@
(channel-news
(version 0)
+ (entry (commit "FIXME")
+ (title
+ (en "New @command{guix locate} command"))
+ (body
+ (en "The new @command{guix locate} command lets you search for
+packages containing a given file---at long last! For instance, to find which
+package(s) provide a file named @file{ls}, run:
+
+@example
+guix locate ls
+@end example
+
+Currently the command relies on purely local information. It is thus unable
+to find packages that have not been directly or indirectly reached your store.
+This limitation will be lifted in a future revision.
+Run @command{info \"Invoking guix locate\"} for more info.")))
+
(entry (commit "ba5da5125a81307500982517e2f458d57b024668")
(title
(en "New @code{arguments} rule for @command{guix style}")
--
2.40.1
^ permalink raw reply related [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v2 2/3] Add 'guix locate'.
2023-06-07 22:09 ` [bug#62264] [PATCH v2 2/3] Add 'guix locate' Ludovic Courtès
@ 2023-06-08 17:27 ` Jelle Licht
2023-06-16 14:20 ` [bug#62264] [PATCH] Add 'guix locate' command Ludovic Courtès
2023-06-08 20:59 ` [bug#62264] [PATCH v2 2/3] Add 'guix locate' pelzflorian (Florian Pelz)
1 sibling, 1 reply; 28+ messages in thread
From: Jelle Licht @ 2023-06-08 17:27 UTC (permalink / raw)
To: Ludovic Courtès, 62264; +Cc: Antoine R . Dumont
Hi Ludo,
Thanks for this cool feature. I have only found nitpicks, that should
most definitely not hold up this series.
Ludovic Courtès <ludo@gnu.org> writes:
> * 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.
>
> Co-authored-by: Antoine R. Dumont <antoine.romain.dumont@gmail.com>
> ---
> Makefile.am | 2 +
> doc/guix.texi | 118 ++++++++
> guix/scripts/locate.scm | 657 ++++++++++++++++++++++++++++++++++++++++
> po/guix/POTFILES.in | 1 +
> tests/guix-locate.sh | 72 +++++
> 5 files changed, 850 insertions(+)
> create mode 100644 guix/scripts/locate.scm
> create mode 100755 tests/guix-locate.sh
[snip]
> +@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 Warning
nit: Note seems more applicable, ymmv.
[snip]
> diff --git a/guix/scripts/locate.scm b/guix/scripts/locate.scm
> new file mode 100644
> index 0000000000..b5d8671d9c
> --- /dev/null
> +++ b/guix/scripts/locate.scm
> @@ -0,0 +1,657 @@
> +;;; 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) ;; option
nit: if we are already singling out this module and import, why not
#:select as well?
> + #:use-module (srfi srfi-71)
> + #:export (guix-locate))
> +
> +(define application-version 3)
> +
> +;; The following schema is the full schema at the `application-version`. It
> +;; should be modified according to the development required and
> +;; `application-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 `application-version` (for the existing dbs to know what to migrate).
> +(define schema-full
> + "
> +create table if not exists SchemaVersion (
> + version integer primary key not null,
> + date date,
^ nit: sqlite does not have a native date type.
We seem to be using it like a timestamp rather than a date.
- Jelle
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v2 2/3] Add 'guix locate'.
2023-06-07 22:09 ` [bug#62264] [PATCH v2 2/3] Add 'guix locate' Ludovic Courtès
2023-06-08 17:27 ` Jelle Licht
@ 2023-06-08 20:59 ` pelzflorian (Florian Pelz)
2023-06-09 10:07 ` pelzflorian (Florian Pelz)
2023-06-16 14:25 ` [bug#62264] [PATCH] Add 'guix locate' command Ludovic Courtès
1 sibling, 2 replies; 28+ messages in thread
From: pelzflorian (Florian Pelz) @ 2023-06-08 20:59 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Antoine R . Dumont, 62264
Wow, thank you Antoine and Ludo! This is well thought out. Very nice!
Some comments though:
Ludovic Courtès <ludo@gnu.org> writes:
> * 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.
The commit message is missing the info that this patch also contains the
changes to doc/guix.texi and also to tests/guix-locate.sh.
> diff --git a/doc/guix.texi b/doc/guix.texi
> …
> +@item --datebase=@var{file}
This should be --database not --datebase.
> +@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
The sentence does not end with a period.
I went on to test some things. They are not very important, but still
there are bugs:
After deleting ~/.cache/guix/locate and cd’ing out of my home directory,
then inside “guix shell -CW coreutils”, “guix locate ls” does not find
ls.
When I use “guix locate icecat”, it legitimately also locates a file
lib/icecat/icecat in addition to the desired bin/icecat. I try to
filter by “guix locate bin/icecat” or “guix locate -g bin/icecat”, but
it seems locate does not support file names with slashes.
Also, “guix locate” crashed for me on a machine where I was using the
nonfree channel to get support for my GPU and not just software
rendering. “guix locate” crashed; it failed to load its module (nongnu
packages ncurses). Sadly, after playing around without the bad channel,
I cannot replicate this anymore with the bad channel. locate works now.
Strange. And I cannot currently test on another machine for unrelated
reasons.
Regards,
Florian
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v2 3/3] DRAFT news: Add entry for 'guix locate'.
2023-06-07 22:09 ` [bug#62264] [PATCH v2 3/3] DRAFT news: Add entry for 'guix locate' Ludovic Courtès
@ 2023-06-08 21:19 ` pelzflorian (Florian Pelz)
2023-06-16 14:21 ` [bug#62264] [PATCH] Add 'guix locate' command Ludovic Courtès
0 siblings, 1 reply; 28+ messages in thread
From: pelzflorian (Florian Pelz) @ 2023-06-08 21:19 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 62264
Hi Ludo.
Ludovic Courtès <ludo@gnu.org> writes:
> +Run @command{info \"Invoking guix locate\"} for more info.")))
Should be: @command{info \"(guix) Invoking guix locate\"}.
> +Currently the command relies on purely local information. It is thus unable
> +to find packages that have not been directly or indirectly reached your store.
The word “been” is wrong. It is not clear to me: What does directly or
indirectly mean?
Then, could you add this German translation?
> + (title
> + (en "New @command{guix locate} command"))
(de "Neuer Befehl @command{guix locate}")
> + (body
> + (en "The new @command{guix locate} command lets you search for
(de "Mit dem neuen Befehl @command{guix locate} können Sie nach
Paketen suchen, die eine angegebene Datei enthalten — endlich ist es
soweit! Um zum Beispiel das Paket bzw.@: die Pakete zu finden, die eine
Datei namens @file{ls} bereitstellen, führen Sie aus:
@example
guix locate ls
@end example
Derzeit benutzt der Befehl ausschließlich lokal vorliegende
Informationen. Daher können Sie damit nur Pakete finden, die sich in
Ihrem Store-Verzeichnis befinden. Diese Einschränkung werden wir in
einer zukünftigen Version aufheben.
Führen Sie @command{info \"Invoking guix locate\"} aus, um mehr zu
erfahren.")))
Regards,
Florian
^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [bug#62264] [PATCH v2 0/3] Add 'guix locate'
2023-06-07 22:09 ` [bug#62264] [PATCH v2 0/3] Add 'guix locate' Ludovic Courtès
@ 2023-06-09 3:57 ` Ryan Prior
2023-06-15 22:02 ` bug#62264: [PATCH] Add 'guix locate' command Ludovic Courtès
0 siblings, 1 reply; 28+ messages in thread
From: Ryan Prior @ 2023-06-09 3:57 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 62264, Antoine R. Dumont, guix-devel
------- Original Message -------
On Wednesday, June 7th, 2023 at 10:09 PM, Ludovic Courtès <ludo@gnu.org> wrote:
>
>
> Hello!
>
> Here is the “camera-ready” version of the new ‘guix locate’ command
> (formerly ‘guix index’) that Antoine and myself have worked on.
> I think it’s ready to go.
It would be helpful to provide a link to any documentation that's part of this work, as neither "guix locate" nor "guix index" have been discussed on guix-devel previously. I look forward to learning more about this feature!
Ryan
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v2 2/3] Add 'guix locate'.
2023-06-08 20:59 ` [bug#62264] [PATCH v2 2/3] Add 'guix locate' pelzflorian (Florian Pelz)
@ 2023-06-09 10:07 ` pelzflorian (Florian Pelz)
2023-06-16 14:25 ` [bug#62264] [PATCH] Add 'guix locate' command Ludovic Courtès
1 sibling, 0 replies; 28+ messages in thread
From: pelzflorian (Florian Pelz) @ 2023-06-09 10:07 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Antoine R . Dumont, 62264
"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
> Also, “guix locate” crashed for me on a machine where I was using the
The crash is unrelated to locate. Possibly some problem with caches. I
cannot replicate the crash anymore and I cannot replicate the crash on
other machines.
Other sub-issues with the doc, the news, guix shell or with searching
for file names with slashes remain valid.
Regards,
Florian
^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: bug#62264: [PATCH] Add 'guix locate' command
2023-06-09 3:57 ` Ryan Prior
@ 2023-06-15 22:02 ` Ludovic Courtès
0 siblings, 0 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-15 22:02 UTC (permalink / raw)
To: Ryan Prior; +Cc: guix-devel, Antoine R. Dumont, 62264
Hi Ryan,
Ryan Prior <rprior@protonmail.com> skribis:
> It would be helpful to provide a link to any documentation that's part of this work, as neither "guix locate" nor "guix index" have been discussed on guix-devel previously. I look forward to learning more about this feature!
You can find the discussion leading to this patch series at:
https://issues.guix.gnu.org/62264
Current documentation:
https://issues.guix.gnu.org/62264#12-lineno60
Before that, there was a preliminary discussion at:
https://lists.gnu.org/archive/html/guix-devel/2022-01/msg00354.html
HTH!
Ludo’.
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH] Add 'guix locate' command
2023-06-08 17:27 ` Jelle Licht
@ 2023-06-16 14:20 ` Ludovic Courtès
0 siblings, 0 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-16 14:20 UTC (permalink / raw)
To: Jelle Licht; +Cc: Antoine R . Dumont, 62264
Hi Jelle,
Jelle Licht <jlicht@fsfe.org> skribis:
> Ludovic Courtès <ludo@gnu.org> writes:
[...]
>> +create table if not exists SchemaVersion (
>> + version integer primary key not null,
>> + date date,
> ^ nit: sqlite does not have a native date type.
>
> We seem to be using it like a timestamp rather than a date.
That got me to learn about all this, as discussed on IRC, and I changed
it to ‘integer’.
Also took your other comments into account, thank you!
Ludo’.
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH] Add 'guix locate' command
2023-06-08 21:19 ` pelzflorian (Florian Pelz)
@ 2023-06-16 14:21 ` Ludovic Courtès
0 siblings, 0 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-16 14:21 UTC (permalink / raw)
To: pelzflorian (Florian Pelz); +Cc: 62264
Hi,
"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:
>> +Currently the command relies on purely local information. It is thus unable
>> +to find packages that have not been directly or indirectly reached your store.
>
> The word “been” is wrong. It is not clear to me: What does directly or
> indirectly mean?
Oops. I changed it to: “find packages that have not reached your store.”
> Then, could you add this German translation?
Done, thanks! Also took into account your other comment.
Ludo’.
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH] Add 'guix locate' command
2023-06-08 20:59 ` [bug#62264] [PATCH v2 2/3] Add 'guix locate' pelzflorian (Florian Pelz)
2023-06-09 10:07 ` pelzflorian (Florian Pelz)
@ 2023-06-16 14:25 ` Ludovic Courtès
2023-06-16 14:26 ` [bug#62264] [PATCH v3 1/3] store: Tolerate non-existent GC root directories Ludovic Courtès
` (3 more replies)
1 sibling, 4 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-16 14:25 UTC (permalink / raw)
To: pelzflorian (Florian Pelz); +Cc: Antoine R . Dumont, 62264
Hi,
I fixed the typos/issues you reported.
"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:
> I went on to test some things. They are not very important, but still
> there are bugs:
>
> After deleting ~/.cache/guix/locate and cd’ing out of my home directory,
> then inside “guix shell -CW coreutils”, “guix locate ls” does not find
> ls.
Works for me:
--8<---------------cut here---------------start------------->8---
$ guix shell -CW -D guix
The following derivation will be built:
/gnu/store/570gc0xgf6sijhjdgh406ykx7ysfckfp-profile.drv
building CA certificate bundle...
listing Emacs sub-directories...
building fonts directory...
generating GLib schema cache...
building directory of Info manuals...
building XDG desktop file cache...
building XDG MIME database...
building profile with 57 packages...
[env]$ ./pre-inst-env guix locate ls
coreutils-minimal@8.32 /gnu/store/vqdsrvs9jbn0ix2a58s99jwkh74124y5-coreutils-minimal-8.32/bin/ls
coreutils@8.32 /gnu/store/9a0cjh929maqvkxn3inv6jqbxn72fkx0-coreutils-8.32/bin/ls
coreutils@9.1 /gnu/store/skcwbg8v0w643w71j9zx25cq0a6dwirs-coreutils-9.1/bin/ls
--8<---------------cut here---------------end--------------->8---
Note that ‘-W’ has the effect of sharing ~/.cache with the container.
That means that the database is already there.
> When I use “guix locate icecat”, it legitimately also locates a file
> lib/icecat/icecat in addition to the desired bin/icecat. I try to
> filter by “guix locate bin/icecat” or “guix locate -g bin/icecat”, but
> it seems locate does not support file names with slashes.
Right: ‘guix locate’ only checks the “basename”; it does not let you
search on the absolute file name. We could add an option to do that
later (say ‘-f’) but I thought it’s less frequently useful.
Thanks for testing and reporting back!
I’m sending the final version taking into account your comments and
those by Jelle. I’ll push it in the coming days if there are no
objections.
Thanks!
Ludo’.
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v3 1/3] store: Tolerate non-existent GC root directories.
2023-06-16 14:25 ` [bug#62264] [PATCH] Add 'guix locate' command Ludovic Courtès
@ 2023-06-16 14:26 ` Ludovic Courtès
2023-06-16 14:26 ` [bug#62264] [PATCH v3 2/3] Add 'guix locate' Ludovic Courtès
` (2 subsequent siblings)
3 siblings, 0 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-16 14:26 UTC (permalink / raw)
To: 62264
Cc: Ludovic Courtès, Christopher Baines, Josselin Poiret,
Ludovic Courtès, Mathieu Othacehe, Ricardo Wurmus,
Simon Tournier, Tobias Geerinckx-Rice
* guix/store/roots.scm (gc-roots): Wrap 'scandir*' call in 'catch'.
* tests/store-roots.scm ("gc-roots, initial"): New test. Move
'open-connection' call below.
---
guix/store/roots.scm | 12 ++++++++++--
tests/store-roots.scm | 18 +++++++++++++++---
2 files changed, 25 insertions(+), 5 deletions(-)
diff --git a/guix/store/roots.scm b/guix/store/roots.scm
index 222f69c5c0..6b949b5a86 100644
--- a/guix/store/roots.scm
+++ b/guix/store/roots.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2014, 2017, 2019, 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -105,7 +105,15 @@ (define (gc-roots)
(map (match-lambda
((file . properties)
(cons (scope file) properties)))
- (scandir* directory regular?)))))
+ (catch 'system-error
+ (lambda ()
+ (scandir* directory regular?))
+ (lambda args
+ (if (= ENOENT
+ (system-error-errno
+ args))
+ '()
+ (apply throw args))))))))
(loop (append rest (map first sub-directories))
(append (map canonical-root (filter symlink? files))
roots)
diff --git a/tests/store-roots.scm b/tests/store-roots.scm
index 5bcf1bc87e..9877987a65 100644
--- a/tests/store-roots.scm
+++ b/tests/store-roots.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,14 +21,26 @@ (define-module (test-store-deduplication)
#:use-module (guix store)
#:use-module (guix store roots)
#:use-module ((guix utils) #:select (call-with-temporary-directory))
+ #:use-module ((guix build utils) #:select (delete-file-recursively))
+ #:use-module ((guix config) #:select (%state-directory))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64))
-(define %store
- (open-connection))
+(define %store #f)
(test-begin "store-roots")
+(test-equal "gc-roots, initial"
+ (list (string-append %state-directory "/profiles"))
+ (begin
+ ;; 'gc-roots' should gracefully handle lack of that directory.
+ (delete-file-recursively (string-append %state-directory "/profiles"))
+ (gc-roots)))
+
+;; The 'open-connection' call below gets guix-daemon to create
+;; %STATE-DIRECTORY/profiles.
+(set! %store (open-connection))
+
(test-assert "gc-roots, regular root"
(let* ((item (add-text-to-store %store "something"
(random-text)))
base-commit: 31336e9f5d68512a9c1c6826bce9f17c892a2125
--
2.40.1
^ permalink raw reply related [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v3 2/3] Add 'guix locate'.
2023-06-16 14:25 ` [bug#62264] [PATCH] Add 'guix locate' command Ludovic Courtès
2023-06-16 14:26 ` [bug#62264] [PATCH v3 1/3] store: Tolerate non-existent GC root directories Ludovic Courtès
@ 2023-06-16 14:26 ` Ludovic Courtès
2023-06-16 14:27 ` [bug#62264] [PATCH v3 3/3] DRAFT news: Add entry for " Ludovic Courtès
2023-06-17 15:56 ` [bug#62264] [PATCH] Add 'guix locate' command pelzflorian (Florian Pelz)
3 siblings, 0 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-16 14:26 UTC (permalink / raw)
To: 62264
Cc: Antoine R . Dumont, Ludovic Courtès, Christopher Baines,
Florian Pelz, Josselin Poiret, Julien Lepiller,
Ludovic Courtès, Mathieu Othacehe, Ricardo Wurmus,
Simon Tournier, Tobias Geerinckx-Rice
* 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 | 2 +
doc/guix.texi | 128 ++++++++
guix/scripts/locate.scm | 659 ++++++++++++++++++++++++++++++++++++++++
po/guix/POTFILES.in | 1 +
tests/guix-locate.sh | 72 +++++
5 files changed, 862 insertions(+)
create mode 100644 guix/scripts/locate.scm
create mode 100755 tests/guix-locate.sh
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 9232c82b4b..fa7c4ae0f0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -258,6 +258,7 @@ Top
* 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 @@ 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.
@@ -4417,6 +4419,132 @@ Packages with Multiple Outputs
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.
+
+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))))))))
+
+\f
+;;;
+;;; 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)))))
+
+\f
+;;;
+;;; 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)))
+
+
+\f
+;;;
+;;; 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))
+
+\f
+;;;
+;;; 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)))
+
+\f
+;;;
+;;; 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
--
2.40.1
^ permalink raw reply related [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v3 3/3] DRAFT news: Add entry for 'guix locate'.
2023-06-16 14:25 ` [bug#62264] [PATCH] Add 'guix locate' command Ludovic Courtès
2023-06-16 14:26 ` [bug#62264] [PATCH v3 1/3] store: Tolerate non-existent GC root directories Ludovic Courtès
2023-06-16 14:26 ` [bug#62264] [PATCH v3 2/3] Add 'guix locate' Ludovic Courtès
@ 2023-06-16 14:27 ` Ludovic Courtès
2023-06-17 15:35 ` pelzflorian (Florian Pelz)
2023-06-17 15:56 ` [bug#62264] [PATCH] Add 'guix locate' command pelzflorian (Florian Pelz)
3 siblings, 1 reply; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-16 14:27 UTC (permalink / raw)
To: 62264; +Cc: Ludovic Courtès, Florian Pelz, Florian Pelz, Julien Lepiller
* etc/news.scm: Add entry.
Co-authored-by: Florian Pelz <pelzflorian@pelzflorian.de>
---
etc/news.scm | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 49 insertions(+)
diff --git a/etc/news.scm b/etc/news.scm
index 314f0ab352..0694a10613 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -26,6 +26,55 @@
(channel-news
(version 0)
+ (entry (commit "FIXME")
+ (title
+ (en "New @command{guix locate} command")
+ (de "Neuer Befehl @command{guix locate}")
+ (fr "Nouvelle command @command{guix locate}"))
+ (body
+ (en "The new @command{guix locate} command lets you search for
+packages containing a given file---at long last! For instance, to find which
+package(s) provide a file named @file{ls}, run:
+
+@example
+guix locate ls
+@end example
+
+Currently the command relies on purely local information. It is thus unable
+to find packages that have not reached your store. This limitation will be
+lifted in a future revision.
+
+Run @command{info \"(guix) Invoking guix locate\"} for more info.")
+ (de "Mit dem neuen Befehl @command{guix locate} können Sie nach
+Paketen suchen, die eine angegebene Datei enthalten — endlich ist es
+soweit! Um zum Beispiel das Paket bzw.@: die Pakete zu finden, die eine
+Datei namens @file{ls} bereitstellen, führen Sie aus:
+
+@example
+guix locate ls
+@end example
+
+Derzeit benutzt der Befehl ausschließlich lokal vorliegende
+Informationen. Daher können Sie damit nur Pakete finden, die sich in
+Ihrem Store-Verzeichnis befinden. Diese Einschränkung werden wir in
+einer zukünftigen Version aufheben.
+
+Führen Sie @command{info \"Invoking guix locate\"} aus, um mehr zu
+erfahren.")
+ (fr "La nouvelle commande @command{guix locate} permet de chercher le
+ou les paquets contenant un fichier donné---enfin ! Par exemple, pour trouver
+quel paquet fournit un fichier nommé @file{ls}, on lance :
+
+@example
+guix locate ls
+@end example
+
+Pour le moment la commande se base uniquement sur des informations locales.
+Elle ne peut donc pas trouver des paquets dans votre dépôt. Cette limitation
+sera levée dans une prochaine version.
+
+Lancer @command{info \"(guix) Invoking guix locate\"} pour plus d'informations.")))
+
(entry (commit "ba5da5125a81307500982517e2f458d57b024668")
(title
(en "New @code{arguments} rule for @command{guix style}")
--
2.40.1
^ permalink raw reply related [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH v3 3/3] DRAFT news: Add entry for 'guix locate'.
2023-06-16 14:27 ` [bug#62264] [PATCH v3 3/3] DRAFT news: Add entry for " Ludovic Courtès
@ 2023-06-17 15:35 ` pelzflorian (Florian Pelz)
0 siblings, 0 replies; 28+ messages in thread
From: pelzflorian (Florian Pelz) @ 2023-06-17 15:35 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Julien Lepiller, 62264
Ludovic Courtès <ludo@gnu.org> writes:
> +Run @command{info \"(guix) Invoking guix locate\"} for more info.")
> …
> +Führen Sie @command{info \"Invoking guix locate\"} aus, um mehr zu
> +erfahren.")
Could you add the missing (guix) to my German translation as well? I
had forgotten. Sorry for getting confused myself.
Regards,
Florian
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH] Add 'guix locate' command
2023-06-16 14:25 ` [bug#62264] [PATCH] Add 'guix locate' command Ludovic Courtès
` (2 preceding siblings ...)
2023-06-16 14:27 ` [bug#62264] [PATCH v3 3/3] DRAFT news: Add entry for " Ludovic Courtès
@ 2023-06-17 15:56 ` pelzflorian (Florian Pelz)
2023-06-18 21:51 ` Ludovic Courtès
3 siblings, 1 reply; 28+ messages in thread
From: pelzflorian (Florian Pelz) @ 2023-06-17 15:56 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Antoine R . Dumont, 62264
Greetings Ludo,
Ludovic Courtès <ludo@gnu.org> writes:
>> After deleting ~/.cache/guix/locate and cd’ing out of my home directory,
>> then inside “guix shell -CW coreutils”, “guix locate ls” does not find
>> ls.
>
> Works for me:
>
> $ guix shell -CW -D guix
> […]
> Note that ‘-W’ has the effect of sharing ~/.cache with the container.
> That means that the database is already there.
Ah of course that is why it works for you. I had deleted the locate
directory of the cache, so after `guix shell -CW -D guix` the `guix
locate ls` did not work, and did not work either once I had left the
container, because an empty database had been created in the cache from
within the container. Without -CW it works fine. It is a minor bug.
>> When I use “guix locate icecat”, it legitimately also locates a file
>> lib/icecat/icecat in addition to the desired bin/icecat. I try to
>> filter by “guix locate bin/icecat” or “guix locate -g bin/icecat”, but
>> it seems locate does not support file names with slashes.
> Right: ‘guix locate’ only checks the “basename”; it does not let you
> search on the absolute file name. We could add an option to do that
> later (say ‘-f’) but I thought it’s less frequently useful.
I’m nitpicking, but if relative file names are not meant to be
supported, could you change the doc/guix.texi at
+@example
+guix locate [@var{options}@dots{}] @var{file}@dots{}
+@end example
+
+@noindent
+... where @var{file} is the name of a file to search for.
to reflect that FILE must be the basename? Because in other parts of
the doc, the term path is avoided and the term filename is used. Now a
filename is only a basename all of a sudden.
Regards,
Florian
^ permalink raw reply [flat|nested] 28+ messages in thread
* [bug#62264] [PATCH] Add 'guix locate' command
2023-06-17 15:56 ` [bug#62264] [PATCH] Add 'guix locate' command pelzflorian (Florian Pelz)
@ 2023-06-18 21:51 ` Ludovic Courtès
0 siblings, 0 replies; 28+ messages in thread
From: Ludovic Courtès @ 2023-06-18 21:51 UTC (permalink / raw)
To: pelzflorian (Florian Pelz); +Cc: Antoine R . Dumont, 62264
Hi Florian,
"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:
> Ludovic Courtès <ludo@gnu.org> writes:
>>> After deleting ~/.cache/guix/locate and cd’ing out of my home directory,
>>> then inside “guix shell -CW coreutils”, “guix locate ls” does not find
>>> ls.
>>
>> Works for me:
>>
>> $ guix shell -CW -D guix
>> […]
>> Note that ‘-W’ has the effect of sharing ~/.cache with the container.
>> That means that the database is already there.
>
> Ah of course that is why it works for you. I had deleted the locate
> directory of the cache, so after `guix shell -CW -D guix` the `guix
> locate ls` did not work, and did not work either once I had left the
> container, because an empty database had been created in the cache from
> within the container. Without -CW it works fine. It is a minor bug.
Oh right, makes sense (not really a bug in the sense that the ‘profiles’
method just doesn’t find any profile from within ‘guix shell -CW’.)
>>> When I use “guix locate icecat”, it legitimately also locates a file
>>> lib/icecat/icecat in addition to the desired bin/icecat. I try to
>>> filter by “guix locate bin/icecat” or “guix locate -g bin/icecat”, but
>>> it seems locate does not support file names with slashes.
>> Right: ‘guix locate’ only checks the “basename”; it does not let you
>> search on the absolute file name. We could add an option to do that
>> later (say ‘-f’) but I thought it’s less frequently useful.
>
> I’m nitpicking, but if relative file names are not meant to be
> supported, could you change the doc/guix.texi at
>
> +@example
> +guix locate [@var{options}@dots{}] @var{file}@dots{}
> +@end example
> +
> +@noindent
> +... where @var{file} is the name of a file to search for.
>
> to reflect that FILE must be the basename? Because in other parts of
> the doc, the term path is avoided and the term filename is used. Now a
> filename is only a basename all of a sudden.
Yeah, it’s ambiguous: “file name” is generic and applies equally to a
“basename” and to a “fully-qualified name”.
I’ve hopefully clarified this in the manual and pushed the result as
bf9afedef9c55aa0092b562077d9f2c743d9a29c.
Thank you, and again thanks a lot Antoine for giving the initial
impulse!
Ludo’.
^ permalink raw reply [flat|nested] 28+ messages in thread
end of thread, other threads:[~2023-06-18 21:53 UTC | newest]
Thread overview: 28+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-03-18 16:06 [bug#62264] [PATCH core-updates 0/6] Add `guix index` subcommand Antoine R. Dumont (@ardumont)
2023-03-18 16:57 ` [bug#62264] [PATCH core-updates 1-6/6] " Antoine R. Dumont
2023-04-02 21:57 ` [bug#62264] [PATCH core-updates 0/6] " Ludovic Courtès
2023-05-21 21:45 ` Ludovic Courtès
2023-05-22 16:53 ` Simon Tournier
2023-05-24 14:40 ` Ludovic Courtès
2023-05-25 16:20 ` Simon Tournier
2023-05-26 16:44 ` Ludovic Courtès
2023-06-04 22:25 ` Ludovic Courtès
2023-06-07 22:09 ` [bug#62264] [PATCH v2 0/3] Add 'guix locate' Ludovic Courtès
2023-06-09 3:57 ` Ryan Prior
2023-06-15 22:02 ` bug#62264: [PATCH] Add 'guix locate' command Ludovic Courtès
2023-06-07 22:09 ` [bug#62264] [PATCH v2 1/3] store: Tolerate non-existent GC root directories Ludovic Courtès
2023-06-07 22:09 ` [bug#62264] [PATCH v2 2/3] Add 'guix locate' Ludovic Courtès
2023-06-08 17:27 ` Jelle Licht
2023-06-16 14:20 ` [bug#62264] [PATCH] Add 'guix locate' command Ludovic Courtès
2023-06-08 20:59 ` [bug#62264] [PATCH v2 2/3] Add 'guix locate' pelzflorian (Florian Pelz)
2023-06-09 10:07 ` pelzflorian (Florian Pelz)
2023-06-16 14:25 ` [bug#62264] [PATCH] Add 'guix locate' command Ludovic Courtès
2023-06-16 14:26 ` [bug#62264] [PATCH v3 1/3] store: Tolerate non-existent GC root directories Ludovic Courtès
2023-06-16 14:26 ` [bug#62264] [PATCH v3 2/3] Add 'guix locate' Ludovic Courtès
2023-06-16 14:27 ` [bug#62264] [PATCH v3 3/3] DRAFT news: Add entry for " Ludovic Courtès
2023-06-17 15:35 ` pelzflorian (Florian Pelz)
2023-06-17 15:56 ` [bug#62264] [PATCH] Add 'guix locate' command pelzflorian (Florian Pelz)
2023-06-18 21:51 ` Ludovic Courtès
2023-06-07 22:09 ` [bug#62264] [PATCH v2 3/3] DRAFT news: Add entry for 'guix locate' Ludovic Courtès
2023-06-08 21:19 ` pelzflorian (Florian Pelz)
2023-06-16 14:21 ` [bug#62264] [PATCH] Add 'guix locate' command Ludovic Courtès
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.