[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: File search
|
From: |
Antoine R. Dumont (@ardumont) |
|
Subject: |
Re: File search |
|
Date: |
Sun, 04 Dec 2022 17:35:43 +0100 |
Hello Guix,
Ludo, \o/, thanks for the iteration ;) Not that I understood everything
yet but indeed, it's faster.
I've iterated over your work to:
- align calls to that new function
- improve some docstrings, and imports, and the help message
- drop dead (or redundant) code
- make sure the (xdg) folder holding the db is created if needed
Please, find enclosed the latest implementation as a patch (somewhat vcs
code ;). I've edited commits to mark Ludo as author with his
started/amended implementations first [0] (that should be in the patch).
For information, I extracted some number from runs to compare our
iterations (see the org-file attachment). The first iteration being
"extracts packages from the store" and the second one "extracts packages
from the system manifest". Those runs happened both on a guixified
debian host and a raw guix host (more packages).
It seems with the new implementation, we find less a bit less packages
but it's faster so i guess it's a tradeoff. It'd be nice to know how it
runs on your build farm machine (if you got the time at some point [1]).
[0] fwiw, yeah git and magit! :D
[1] I noticed (through ml discussions) you all are quite busy at the
moment ;)
Cheers,
--
tony / Antoine R. Dumont (@ardumont)
-----------------------------------------------------------------
gpg fingerprint BF00 203D 741A C9D5 46A8 BE07 52E2 E984 0D10 C3B8
Ludovic Courtès <ludo@gnu.org> writes:
> Yay, nice work!
>
> I toyed a bit with your code and that gave me an idea: instead of the
> costly ‘fold-packages’ + ‘package-derivation’, we can iterate over all
> the manifests on the system and index packages they refer to. That way,
> no need to talk to the daemon, computer derivations, etc. Should be
> faster, though of course it still needs to traverse those directories.
>
> Please find attached a modified version that illustrates that. (We’ll
> need version control at some point. :-))
>
> Thanks,
> Ludo’.
>
> ;;; 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 config) ;; %guix-package-name, ...
> #:use-module (guix ui) ;; display G_
> #:use-module (guix scripts)
> #:use-module (sqlite3)
> #:use-module (ice-9 match)
> #: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 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-71)
> #:export (guix-index))
>
> (define debug #f)
>
> (define schema
> "
> 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);")
>
> (define (call-with-database file proc)
> (let ((db (sqlite-open file)))
> (dynamic-wind
> (lambda () #t)
> (lambda ()
> (sqlite-exec db schema)
> (proc db))
> (lambda ()
> (sqlite-close db)))))
>
> (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;"))
>
> (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 (filter-public-current-supported package)
> "Filter supported, not hidden (public) and not superseded (current)
> package."
> (and (not (hidden-package? package))
> (not (package-superseded package))
> (supported-package? package)))
>
> (define (filter-supported-package package)
> "Filter supported package (package might be hidden or superseded)."
> (and (supported-package? package)))
>
> (define (no-filter package) "No filtering on package" #t)
>
> (define* (insert-packages db #:optional (filter-policy
> filter-public-current-supported))
> "Insert all current packages matching `filter-package-policy` into DB."
> (with-store store
> (parameterize ((%graft? #f))
> (fold-packages (lambda (package _)
> (run-with-store store
> (insert-package db package)))
> #t
> #:select? filter-policy))))
>
>
> ;;;
> ;;; Indexing from local profiles.
> ;;;
>
> (define (all-profiles)
> "Return the list of profiles on the system."
> (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 manifest entries for all of PROFILES, without duplicates."
> (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 ENTRY, 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-manifests db-file)
> "Insert into DB-FILE entries for packages that appear in manifests
> available on the system."
> (call-with-database db-file
> (lambda (db)
> (for-each (lambda (entry)
> (insert-manifest-entry db entry))
> (let ((lst (profiles->manifest-entries (all-profiles))))
> (pk 'entries (length lst))
> lst)))))
>
>
> ;;;
> ;;; 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))
>
>
>
>
> (define (index-packages-with-db db-pathname)
> "Index packages using db at location DB-PATHNAME."
> (call-with-database db-pathname
> (lambda (db)
> (insert-packages db no-filter))))
>
> (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 (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 FILE, index (package, file) relationships in the local store.
> With 'search FILE', search for packages installing FILEx;x.\n
> Note: The internal cache is located at ~/.config/guix/locate-db.sqlite.
> 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)
> (newline)
> (display (G_ "The valid values for ARGS are:"))
> (newline)
> (display (G_ "
> search FILE Search for packages installing the FILE (from cache db)"))
> (newline)
> (show-bug-report-information))
>
> (define-command (guix-index . args)
> (category extension)
> (synopsis "Index packages to allow searching package for a given filename")
>
> (define (parse-db-args args)
> "Parsing of string key=value where we are only interested in 'value'"
> (match (string-split args #\=)
> ((unused db-path)
> db-path)
> (_ #f)))
>
> (define (display-help-and-exit)
> (show-help)
> (exit 0))
>
> (match args
> ((or ("-h") ("--help"))
> (display-help-and-exit))
> ((or ("-V") ("--version"))
> (show-version-and-exit "guix locate"))
> ((db-path-args)
> (let ((db-path (parse-db-args db-path-args)))
> (if db-path
> (index-packages-with-db db-path)
> (display-help-and-exit))))
> (("search" file)
> (let ((matches (matching-packages-with-db default-db-path file)))
> (print-matching-results matches)
> (exit (pair? matches))))
> ((db-path-args "search" file)
> (let ((db-path (parse-db-args db-path-args)))
> (if db-path
> (let ((matches (matching-packages-with-db db-path file)))
> (print-matching-results matches)
> (exit (pair? matches)))
> (display-help-and-exit))))
> (_ ;; index by default
> ;; (index-packages-with-db default-db-path)
> (index-manifests default-db-path)
> )))
===File ~/repo/public/guix/guix/add-extension-guix-index.patch===
From d3e658ca1e3ce2715e25450b794d139d3417c74c 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 01/18] extensions-index: Add initial implementation from
civodul
Related to https://lists.gnu.org/archive/html/guix-devel/2022-01/msg00354.html
---
guix/extensions/file-database.scm | 199 ++++++++++++++++++++++++++++++
1 file changed, 199 insertions(+)
create mode 100644 guix/extensions/file-database.scm
diff --git a/guix/extensions/file-database.scm
b/guix/extensions/file-database.scm
new file mode 100644
index 0000000000..83aafbc554
--- /dev/null
+++ b/guix/extensions/file-database.scm
@@ -0,0 +1,199 @@
+;;; 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 (file-database)
+ #:use-module (sqlite3)
+ #:use-module (ice-9 match)
+ #:use-module (guix store)
+ #:use-module (guix monads)
+ #:autoload (guix grafts) (%graft?)
+ #:use-module (guix derivations)
+ #:use-module (guix packages)
+ #:autoload (guix build utils) (find-files)
+ #:autoload (gnu packages) (fold-packages)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:export (file-database))
+
+(define schema
+ "
+create table if not exists Packages (
+ id integer primary key autoincrement not null,
+ name text not null,
+ version text not null
+);
+
+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
+);
+
+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
+);
+
+create index if not exists IndexFiles on Files(basename);")
+
+(define (call-with-database file proc)
+ (let ((db (sqlite-open file)))
+ (dynamic-wind
+ (lambda () #t)
+ (lambda ()
+ (sqlite-exec db schema)
+ (proc db))
+ (lambda ()
+ (sqlite-close db)))))
+
+(define (insert-files db package version directories)
+ "Insert the files contained in DIRECTORIES as belonging to PACKAGE at
+VERSION."
+ (define last-row-id-stmt
+ (sqlite-prepare db "SELECT last_insert_rowid();"
+ #:cache? #t))
+
+ (define package-stmt
+ (sqlite-prepare db "\
+INSERT OR REPLACE INTO Packages(name, version)
+VALUES (:name, :version);"
+ #:cache? #t))
+
+ (define directory-stmt
+ (sqlite-prepare db "\
+INSERT INTO Directories(name, package) VALUES (:name, :package);"
+ #:cache? #t))
+
+ (define file-stmt
+ (sqlite-prepare db "\
+INSERT INTO Files(name, basename, directory)
+VALUES (:name, :basename, :directory);"
+ #:cache? #t))
+
+ (sqlite-exec db "begin immediate;")
+ (sqlite-bind-arguments package-stmt
+ #:name package
+ #:version version)
+ (sqlite-fold (const #t) #t package-stmt)
+ (match (sqlite-fold cons '() last-row-id-stmt)
+ ((#(package-id))
+ (pk 'package package-id package)
+ (for-each (lambda (directory)
+ (define (strip file)
+ (string-drop file (+ (string-length directory) 1)))
+
+ (sqlite-reset directory-stmt)
+ (sqlite-bind-arguments directory-stmt
+ #:name directory
+ #:package package-id)
+ (sqlite-fold (const #t) #t directory-stmt)
+
+ (match (sqlite-fold cons '() last-row-id-stmt)
+ ((#(directory-id))
+ (for-each (lambda (file)
+ ;; If DIRECTORY is a symlink, (find-files
+ ;; DIRECTORY) returns the DIRECTORY singleton.
+ (unless (string=? file directory)
+ (sqlite-reset file-stmt)
+ (sqlite-bind-arguments file-stmt
+ #:name (strip file)
+ #:basename
+ (basename file)
+ #:directory
+ directory-id)
+ (sqlite-fold (const #t) #t file-stmt)))
+ (find-files directory)))))
+ directories)
+ (sqlite-exec db "commit;"))))
+
+(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 db)
+ "Insert all the current packages into DB."
+ (with-store store
+ (parameterize ((%graft? #f))
+ (fold-packages (lambda (package _)
+ (run-with-store store
+ (insert-package db package)))
+ #t
+ #:select? (lambda (package)
+ (and (not (hidden-package? package))
+ (not (package-superseded package))
+ (supported-package? package)))))))
+
+(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 a list of <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))
+
+
+(define (file-database . args)
+ (match args
+ ((_ "populate")
+ (call-with-database "/tmp/db"
+ (lambda (db)
+ (insert-packages db))))
+ ((_ "search" file)
+ (let ((matches (call-with-database "/tmp/db"
+ (lambda (db)
+ (matching-packages db file)))))
+ (for-each (lambda (result)
+ (format #t "~20a ~a~%"
+ (string-append (package-match-name result)
+ "@" (package-match-version result))
+ (package-match-file result)))
+ matches)
+ (exit (pair? matches))))
+ (_
+ (format (current-error-port)
+ "usage: file-database [populate|search] args ...~%")
+ (exit 1))))
+
+(apply file-database (command-line))
--
2.38.1
From d9139cc86c26f76bc66f7d82868ebf6a03605f76 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Thu, 1 Dec 2022 13:36:28 +0100
Subject: [PATCH 02/18] extensions-index: Transform command into `guix locate`
extension
---
.../{file-database.scm => locate.scm} | 58 ++++++++++++-------
1 file changed, 36 insertions(+), 22 deletions(-)
rename guix/extensions/{file-database.scm => locate.scm} (82%)
diff --git a/guix/extensions/file-database.scm b/guix/extensions/locate.scm
similarity index 82%
rename from guix/extensions/file-database.scm
rename to guix/extensions/locate.scm
index 83aafbc554..1e42f5bad8 100644
--- a/guix/extensions/file-database.scm
+++ b/guix/extensions/locate.scm
@@ -16,7 +16,8 @@
;;; 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 (file-database)
+(define-module (guix extensions locate)
+ #:use-module (guix scripts)
#:use-module (sqlite3)
#:use-module (ice-9 match)
#:use-module (guix store)
@@ -28,7 +29,7 @@ (define-module (file-database)
#:autoload (gnu packages) (fold-packages)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
- #:export (file-database))
+ #:export (guix-locate))
(define schema
"
@@ -155,8 +156,7 @@ (define-record-type <package-match>
(file package-match-file))
(define (matching-packages db file)
- "Return a list of <package-match> corresponding to packages containing
-FILE."
+ "Return list of <package-match> corresponding to packages containing FILE."
(define lookup-stmt
(sqlite-prepare db "\
SELECT Packages.name, Packages.version, Directories.name, Files.name
@@ -174,26 +174,40 @@ (define lookup-stmt
'() lookup-stmt))
-(define (file-database . args)
+
+(define (index-packages-with-db db-pathname)
+ "Index packages using db at location DB-PATHNAME."
+ (call-with-database db-pathname
+ (lambda (db)
+ (insert-packages 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 (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-command (guix-locate . args)
+ (category extension)
+ (synopsis "Index packages then search what package declares a given file")
(match args
- ((_ "populate")
- (call-with-database "/tmp/db"
- (lambda (db)
- (insert-packages db))))
- ((_ "search" file)
- (let ((matches (call-with-database "/tmp/db"
- (lambda (db)
- (matching-packages db file)))))
- (for-each (lambda (result)
- (format #t "~20a ~a~%"
- (string-append (package-match-name result)
- "@" (package-match-version result))
- (package-match-file result)))
- matches)
+ (("index")
+ (index-packages-with-db "/tmp/db"))
+ (("search" file)
+ (let ((matches (matching-packages-with-db "/tmp/db" file)))
+ (print-matching-results matches)
(exit (pair? matches))))
(_
(format (current-error-port)
- "usage: file-database [populate|search] args ...~%")
+ "usage: guix locate [index|search] args ...~% ~a"
+ args)
(exit 1))))
-
-(apply file-database (command-line))
--
2.38.1
From eb474f3412ba19320dceda7d08c7f960d00cb898 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Thu, 1 Dec 2022 13:45:59 +0100
Subject: [PATCH 03/18] extensions-index: Avoid duplicating the hard-coded db
path
---
guix/extensions/locate.scm | 8 ++++++--
1 file changed, 6 insertions(+), 2 deletions(-)
diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm
index 1e42f5bad8..830dfc49fb 100644
--- a/guix/extensions/locate.scm
+++ b/guix/extensions/locate.scm
@@ -196,14 +196,18 @@ (define (print-matching-results matches)
(package-match-file result)))
matches))
+;; TODO: Determine the current guile/guix mechanism to provide configuration
+;; for this
+(define default-location-db-path "/tmp/db")
+
(define-command (guix-locate . args)
(category extension)
(synopsis "Index packages then search what package declares a given file")
(match args
(("index")
- (index-packages-with-db "/tmp/db"))
+ (index-packages-with-db default-location-db-path))
(("search" file)
- (let ((matches (matching-packages-with-db "/tmp/db" file)))
+ (let ((matches (matching-packages-with-db default-location-db-path file)))
(print-matching-results matches)
(exit (pair? matches))))
(_
--
2.38.1
From 309ecd5d5b7cdff012b66cbe9643c34725b22a2d Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Thu, 1 Dec 2022 13:47:19 +0100
Subject: [PATCH 04/18] extensions-index: Deduplicate lookup matching results
---
guix/extensions/locate.scm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm
index 830dfc49fb..ab0a0403ec 100644
--- a/guix/extensions/locate.scm
+++ b/guix/extensions/locate.scm
@@ -156,10 +156,10 @@ (define-record-type <package-match>
(file package-match-file))
(define (matching-packages db file)
- "Return list of <package-match> corresponding to packages containing 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
+SELECT DISTINCT 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;"))
--
2.38.1
From 541615ab6638b1fb418531f961cfb6756b41499b Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Fri, 2 Dec 2022 14:09:52 +0100
Subject: [PATCH 05/18] extensions-index: Make insertion queries idempotent
Prior to this, multiple runs of the index subcommand would append the same
packages, directories or files in the db.
---
guix/extensions/locate.scm | 71 ++++++++++++++++++++++++--------------
1 file changed, 45 insertions(+), 26 deletions(-)
diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm
index ab0a0403ec..ce8306531f 100644
--- a/guix/extensions/locate.scm
+++ b/guix/extensions/locate.scm
@@ -36,14 +36,16 @@ (define schema
create table if not exists Packages (
id integer primary key autoincrement not null,
name text not null,
- version 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
+ foreign key (package) references Packages(id) on delete cascade,
+ unique (name, package) -- add uniqueness constraint
);
create table if not exists Files (
@@ -51,6 +53,7 @@ (define schema
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);")
@@ -66,64 +69,78 @@ (define (call-with-database file proc)
(sqlite-close db)))))
(define (insert-files db package version directories)
- "Insert the files contained in DIRECTORIES as belonging to PACKAGE at
-VERSION."
- (define last-row-id-stmt
- (sqlite-prepare db "SELECT last_insert_rowid();"
+ "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 package-stmt
+ (define stmt-insert-package
(sqlite-prepare db "\
-INSERT OR REPLACE INTO Packages(name, version)
+INSERT OR IGNORE INTO Packages(name, version) -- to avoid spurious writes
VALUES (:name, :version);"
#:cache? #t))
- (define directory-stmt
+ (define stmt-select-directory
(sqlite-prepare db "\
-INSERT INTO Directories(name, package) VALUES (:name, :package);"
+SELECT id FROM Directories WHERE name = :name AND package = :package;"
#:cache? #t))
- (define file-stmt
+ (define stmt-insert-directory
(sqlite-prepare db "\
-INSERT INTO Files(name, basename, directory)
+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 package-stmt
+ (sqlite-bind-arguments stmt-insert-package
#:name package
#:version version)
- (sqlite-fold (const #t) #t package-stmt)
- (match (sqlite-fold cons '() last-row-id-stmt)
+ (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))
(pk 'package package-id package)
(for-each (lambda (directory)
(define (strip file)
(string-drop file (+ (string-length directory) 1)))
- (sqlite-reset directory-stmt)
- (sqlite-bind-arguments directory-stmt
+ (sqlite-reset stmt-insert-directory)
+ (sqlite-bind-arguments stmt-insert-directory
#:name directory
#:package package-id)
- (sqlite-fold (const #t) #t directory-stmt)
+ (sqlite-fold (const #t) #t stmt-insert-directory)
- (match (sqlite-fold cons '() last-row-id-stmt)
+ (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))
(for-each (lambda (file)
;; If DIRECTORY is a symlink, (find-files
;; DIRECTORY) returns the DIRECTORY singleton.
(unless (string=? file directory)
- (sqlite-reset file-stmt)
- (sqlite-bind-arguments file-stmt
+ (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 file-stmt)))
+ (sqlite-fold (const #t) #t
stmt-insert-file)))
(find-files directory)))))
- directories)
- (sqlite-exec db "commit;"))))
+ directories)))
+ (sqlite-exec db "commit;"))
(define (insert-package db package)
"Insert all the files of PACKAGE into DB."
@@ -159,10 +176,12 @@ (define (matching-packages db file)
"Return unique <package-match> corresponding to packages containing FILE."
(define lookup-stmt
(sqlite-prepare db "\
-SELECT DISTINCT Packages.name, Packages.version, Directories.name, Files.name
+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;"))
+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)
--
2.38.1
From 09d5f6b30ac24a8e8261994a1011ddd13082a4bb Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Fri, 2 Dec 2022 14:10:59 +0100
Subject: [PATCH 06/18] extensions-index: Add debug statement
This is conditional in the top-level debug module variable, false by default.
---
guix/extensions/locate.scm | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm
index ce8306531f..3b43ea887e 100644
--- a/guix/extensions/locate.scm
+++ b/guix/extensions/locate.scm
@@ -31,6 +31,8 @@ (define-module (guix extensions locate)
#:use-module (srfi srfi-9)
#:export (guix-locate))
+(define debug #f)
+
(define schema
"
create table if not exists Packages (
@@ -109,6 +111,9 @@ (define stmt-insert-file
#: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)
@@ -126,6 +131,9 @@ (define (strip file)
#: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.
--
2.38.1
From b50267e3d24162cd8c3908bbaa841d13363621e9 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Fri, 2 Dec 2022 14:11:50 +0100
Subject: [PATCH 07/18] extensions-index: Play around the packaging filtering
functions
This keeps the default behavior but allows to change it (by the developer) to
determine what's the best policy.
---
guix/extensions/locate.scm | 23 ++++++++++++++++-------
1 file changed, 16 insertions(+), 7 deletions(-)
diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm
index 3b43ea887e..9679d643a6 100644
--- a/guix/extensions/locate.scm
+++ b/guix/extensions/locate.scm
@@ -160,18 +160,27 @@ (define (insert-package db package)
directories))
(return #t)))))
-(define (insert-packages db)
- "Insert all the current packages into DB."
+(define (filter-public-current-supported package)
+ "Filter supported, not hidden (public) and not superseded (current) package."
+ (and (not (hidden-package? package))
+ (not (package-superseded package))
+ (supported-package? package)))
+
+(define (filter-supported-package package)
+ "Filter supported package (package might be hidden or superseded)."
+ (and (supported-package? package)))
+
+(define (no-filter package) "No filtering on package" #t)
+
+(define* (insert-packages db #:optional (filter-policy
filter-public-current-supported))
+ "Insert all current packages matching `filter-package-policy` into DB."
(with-store store
(parameterize ((%graft? #f))
(fold-packages (lambda (package _)
(run-with-store store
(insert-package db package)))
#t
- #:select? (lambda (package)
- (and (not (hidden-package? package))
- (not (package-superseded package))
- (supported-package? package)))))))
+ #:select? filter-policy))))
(define-record-type <package-match>
(package-match name version file)
@@ -206,7 +215,7 @@ (define (index-packages-with-db db-pathname)
"Index packages using db at location DB-PATHNAME."
(call-with-database db-pathname
(lambda (db)
- (insert-packages db))))
+ (insert-packages db no-filter))))
(define (matching-packages-with-db db-pathname file)
"Compute list of packages referencing FILE using db at DB-PATHNAME."
--
2.38.1
From 3b5c765fc967cef1d6919b66acc2d7872ea1e48c Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Fri, 2 Dec 2022 15:19:24 +0100
Subject: [PATCH 08/18] extensions-index: Install db in
~/.config/guix/locate-db.sqlite
---
guix/extensions/locate.scm | 9 ++++++---
1 file changed, 6 insertions(+), 3 deletions(-)
diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm
index 9679d643a6..7d19e64a07 100644
--- a/guix/extensions/locate.scm
+++ b/guix/extensions/locate.scm
@@ -232,9 +232,12 @@ (define (print-matching-results matches)
(package-match-file result)))
matches))
-;; TODO: Determine the current guile/guix mechanism to provide configuration
-;; for this
-(define default-location-db-path "/tmp/db")
+(define default-location-db-path
+ (let ((local-config-path
+ (and=> (getenv "HOME")
+ (lambda (home)
+ (string-append home "/.config/guix/")))))
+ (string-append local-config-path "locate-db.sqlite")))
(define-command (guix-locate . args)
(category extension)
--
2.38.1
From f101d12acf05c82cf9678d1cffec76cceba9e845 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Fri, 2 Dec 2022 17:58:18 +0100
Subject: [PATCH 09/18] extensions-index: Improve cli parsing
This unifies with some existing guix commands (import).
---
guix/extensions/locate.scm | 80 +++++++++++++++++++++++++++++++++-----
1 file changed, 71 insertions(+), 9 deletions(-)
diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm
index 7d19e64a07..630560b231 100644
--- a/guix/extensions/locate.scm
+++ b/guix/extensions/locate.scm
@@ -17,9 +17,12 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix extensions locate)
+ #:use-module (guix config) ;; %guix-package-name, ...
+ #:use-module (guix ui) ;; display G_
#:use-module (guix scripts)
#:use-module (sqlite3)
#:use-module (ice-9 match)
+ #:use-module (guix describe)
#:use-module (guix store)
#:use-module (guix monads)
#:autoload (guix grafts) (%graft?)
@@ -232,25 +235,84 @@ (define (print-matching-results matches)
(package-match-file result)))
matches))
-(define default-location-db-path
+(define default-db-path
(let ((local-config-path
(and=> (getenv "HOME")
(lambda (home)
(string-append home "/.config/guix/")))))
(string-append local-config-path "locate-db.sqlite")))
+(define (show-bug-report-information)
+ ;; TRANSLATORS: The placeholder indicates the bug-reporting address for this
+ ;; package. Please add another line saying "Report translation bugs to
+ ;; ...\n" with the address for translation bugs (typically your translation
+ ;; team's web or email address).
+ (format #t (G_ "
+Report bugs to: ~a.") %guix-bug-report-address)
+ (format #t (G_ "
+~a home page: <~a>") %guix-package-name %guix-home-page-url)
+ (format #t (G_ "
+General help using Guix and GNU software: <~a>")
+ ;; TRANSLATORS: Change the "/en" bit of this URL appropriately if
+ ;; the web site is translated in your language.
+ (G_ "https://guix.gnu.org/en/help/";))
+ (newline))
+
+(define (show-help)
+ (display (G_ "Usage: guix locate [OPTIONS...] [ARGS...]
+Index packages and search what package declares a given file.\n
+By default, the local cache db is located in ~/.config/guix/locate-db.sqlite.
+See --db-path for customization."))
+ (display (G_ "
+ index Index current packages from the local store (in cache db)"))
+ (display (G_ "
+ search FILE Search for packages that declares FILE (from cache db)"))
+ (newline)
+ (display (G_ "
+ --db-path=DIR Change default location of the cache db"))
+ (newline)
+ (display (G_ "
+ -h, --help Display this help and exit"))
+ (display (G_ "
+ -V, --version Display version information and exit"))
+ (newline)
+ (show-bug-report-information))
+
(define-command (guix-locate . args)
(category extension)
- (synopsis "Index packages then search what package declares a given file")
+ (synopsis "Index packages to allow searching package for a given filename")
+
+ (define (parse-db-args args)
+ "Parsing of string key=value where we are only interested in 'value'"
+ (match (string-split args #\=)
+ ((unused db-path)
+ db-path)
+ (_ #f)))
+
+ (define (display-help-and-exit)
+ (show-help)
+ (exit 0))
+
(match args
+ ((or ("-h") ("--help") ())
+ (display-help-and-exit))
+ ((or ("-V") ("--version"))
+ (show-version-and-exit "guix locate"))
+ ((db-path-args "index")
+ (let ((db-path (parse-db-args db-path-args)))
+ (if db-path
+ (index-packages-with-db db-path)
+ (display-help-and-exit))))
(("index")
- (index-packages-with-db default-location-db-path))
+ (index-packages-with-db default-db-path))
(("search" file)
- (let ((matches (matching-packages-with-db default-location-db-path file)))
+ (let ((matches (matching-packages-with-db default-db-path file)))
(print-matching-results matches)
(exit (pair? matches))))
- (_
- (format (current-error-port)
- "usage: guix locate [index|search] args ...~% ~a"
- args)
- (exit 1))))
+ ((db-path-args "search" file)
+ (let ((db-path (parse-db-args db-path-args)))
+ (if db-path
+ (let ((matches (matching-packages-with-db db-path file)))
+ (print-matching-results matches)
+ (exit (pair? matches)))
+ (display-help-and-exit))))))
--
2.38.1
From 9cb0826a71bdada345de100d98e9b44f3503a75a Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Fri, 2 Dec 2022 19:13:46 +0100
Subject: [PATCH 10/18] extensions-index: Improve cli options and help message
This also renames the cli from locate to index.
---
guix/extensions/{locate.scm => index.scm} | 40 +++++++++++++----------
1 file changed, 22 insertions(+), 18 deletions(-)
rename guix/extensions/{locate.scm => index.scm} (93%)
diff --git a/guix/extensions/locate.scm b/guix/extensions/index.scm
similarity index 93%
rename from guix/extensions/locate.scm
rename to guix/extensions/index.scm
index 630560b231..ab7661dbac 100644
--- a/guix/extensions/locate.scm
+++ b/guix/extensions/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 locate)
+(define-module (guix extensions index)
#:use-module (guix config) ;; %guix-package-name, ...
#:use-module (guix ui) ;; display G_
#:use-module (guix scripts)
@@ -32,7 +32,7 @@ (define-module (guix extensions locate)
#:autoload (gnu packages) (fold-packages)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
- #:export (guix-locate))
+ #:export (guix-index))
(define debug #f)
@@ -259,26 +259,30 @@ (define (show-bug-report-information)
(newline))
(define (show-help)
- (display (G_ "Usage: guix locate [OPTIONS...] [ARGS...]
-Index packages and search what package declares a given file.\n
-By default, the local cache db is located in ~/.config/guix/locate-db.sqlite.
-See --db-path for customization."))
- (display (G_ "
- index Index current packages from the local store (in cache db)"))
- (display (G_ "
- search FILE Search for packages that declares FILE (from cache db)"))
+ (display (G_ "Usage: guix index [OPTIONS...] [search FILE...]
+Without FILE, index (package, file) relationships in the local store.
+With 'search FILE', search for packages installing FILEx;x.\n
+Note: The internal cache is located at ~/.config/guix/locate-db.sqlite.
+See --db-path for customization.\n"))
(newline)
- (display (G_ "
- --db-path=DIR Change default location of the cache db"))
+ (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)
+ (newline)
+ (display (G_ "The valid values for ARGS are:"))
+ (newline)
+ (display (G_ "
+ search FILE Search for packages installing the FILE (from cache db)"))
(newline)
(show-bug-report-information))
-(define-command (guix-locate . args)
+(define-command (guix-index . args)
(category extension)
(synopsis "Index packages to allow searching package for a given filename")
@@ -294,17 +298,15 @@ (define (display-help-and-exit)
(exit 0))
(match args
- ((or ("-h") ("--help") ())
+ ((or ("-h") ("--help"))
(display-help-and-exit))
((or ("-V") ("--version"))
(show-version-and-exit "guix locate"))
- ((db-path-args "index")
+ ((db-path-args)
(let ((db-path (parse-db-args db-path-args)))
(if db-path
(index-packages-with-db db-path)
(display-help-and-exit))))
- (("index")
- (index-packages-with-db default-db-path))
(("search" file)
(let ((matches (matching-packages-with-db default-db-path file)))
(print-matching-results matches)
@@ -315,4 +317,6 @@ (define (display-help-and-exit)
(let ((matches (matching-packages-with-db db-path file)))
(print-matching-results matches)
(exit (pair? matches)))
- (display-help-and-exit))))))
+ (display-help-and-exit))))
+ (_ ;; index by default
+ (index-packages-with-db default-db-path))))
--
2.38.1
From f18d1f536bf6b13ec0dd8ee1e865ce21448e3836 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 4 Dec 2022 14:42:45 +0100
Subject: [PATCH 11/18] extensions-index: Iterate over system manifests to
index
This should avoid the extra work of discussing with daemon, computing
derivations, etc...
---
guix/extensions/index.scm | 84 +++++++++++++++++++++++++++++++++++----
1 file changed, 76 insertions(+), 8 deletions(-)
diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm
index ab7661dbac..a7a23c6194 100644
--- a/guix/extensions/index.scm
+++ b/guix/extensions/index.scm
@@ -25,13 +25,19 @@ (define-module (guix extensions index)
#: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 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-71)
#:export (guix-index))
(define debug #f)
@@ -185,6 +191,67 @@ (define* (insert-packages db #:optional (filter-policy
filter-public-current-sup
#t
#:select? filter-policy))))
+
+;;;
+;;; Indexing from local profiles.
+;;;
+
+(define (all-profiles)
+ "Return the list of profiles on the system."
+ (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 manifest entries for all of PROFILES, without duplicates."
+ (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 ENTRY, 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-manifests db-file)
+ "Insert into DB-FILE entries for packages that appear in manifests
+available on the system."
+ (call-with-database db-file
+ (lambda (db)
+ (for-each (lambda (entry)
+ (insert-manifest-entry db entry))
+ (let ((lst (profiles->manifest-entries (all-profiles))))
+ (pk 'entries (length lst))
+ lst)))))
+
+
+;;;
+;;; Search.
+;;;
+
(define-record-type <package-match>
(package-match name version file)
package-match?
@@ -214,6 +281,10 @@ (define lookup-stmt
+;;;
+;;; CLI
+;;;
+
(define (index-packages-with-db db-pathname)
"Index packages using db at location DB-PATHNAME."
(call-with-database db-pathname
@@ -236,11 +307,8 @@ (define (print-matching-results matches)
matches))
(define default-db-path
- (let ((local-config-path
- (and=> (getenv "HOME")
- (lambda (home)
- (string-append home "/.config/guix/")))))
- (string-append local-config-path "locate-db.sqlite")))
+ (string-append (cache-directory #:ensure? #f)
+ "/index/db.sqlite"))
(define (show-bug-report-information)
;; TRANSLATORS: The placeholder indicates the bug-reporting address for this
@@ -261,7 +329,7 @@ (define (show-bug-report-information)
(define (show-help)
(display (G_ "Usage: guix index [OPTIONS...] [search FILE...]
Without FILE, index (package, file) relationships in the local store.
-With 'search FILE', search for packages installing FILEx;x.\n
+With 'search FILE', search for packages installing FILE.\n
Note: The internal cache is located at ~/.config/guix/locate-db.sqlite.
See --db-path for customization.\n"))
(newline)
@@ -318,5 +386,5 @@ (define (display-help-and-exit)
(print-matching-results matches)
(exit (pair? matches)))
(display-help-and-exit))))
- (_ ;; index by default
- (index-packages-with-db default-db-path))))
+ (_ ;; By default, index
+ (index-manifests default-db-path))))
--
2.38.1
From c9b02fc838237ebd7bc38ba7a71587fcdcaf6212 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Sun, 4 Dec 2022 14:45:20 +0100
Subject: [PATCH 12/18] extensions-index: Improve help message
---
guix/extensions/index.scm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm
index a7a23c6194..4a69df326e 100644
--- a/guix/extensions/index.scm
+++ b/guix/extensions/index.scm
@@ -328,9 +328,9 @@ (define (show-bug-report-information)
(define (show-help)
(display (G_ "Usage: guix index [OPTIONS...] [search FILE...]
-Without FILE, index (package, file) relationships in the local store.
+Without argument, indexes (package, file) relationships in the local store.
With 'search FILE', search for packages installing FILE.\n
-Note: The internal cache is located at ~/.config/guix/locate-db.sqlite.
+Note: The internal cache is located at ~/.cache/guix/index/db.sqlite.
See --db-path for customization.\n"))
(newline)
(display (G_ "The valid values for OPTIONS are:"))
--
2.38.1
From d63ef7a97f3fb47b5693b2c1d24bdf276ca6a6a8 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Sun, 4 Dec 2022 14:46:04 +0100
Subject: [PATCH 13/18] extensions-index: Improve imports
---
guix/extensions/index.scm | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm
index 4a69df326e..abaf7df071 100644
--- a/guix/extensions/index.scm
+++ b/guix/extensions/index.scm
@@ -17,8 +17,10 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix extensions index)
- #:use-module (guix config) ;; %guix-package-name, ...
- #:use-module (guix ui) ;; display G_
+ #:use-module ((guix config) #:select (%guix-package-name
+ %guix-home-page-url
+ %guix-bug-report-address))
+ #:use-module ((guix ui) #:select (G_))
#:use-module (guix scripts)
#:use-module (sqlite3)
#:use-module (ice-9 match)
--
2.38.1
From 14a9dafb2b927ba8435a26fdea04b00644e3ca3c Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Sun, 4 Dec 2022 15:52:15 +0100
Subject: [PATCH 14/18] extensions-index: Drop code duplication
Import directly the right function from guix ui module.
---
guix/extensions/index.scm | 23 +++--------------------
1 file changed, 3 insertions(+), 20 deletions(-)
diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm
index abaf7df071..c40edc7944 100644
--- a/guix/extensions/index.scm
+++ b/guix/extensions/index.scm
@@ -17,10 +17,9 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix extensions index)
- #:use-module ((guix config) #:select (%guix-package-name
- %guix-home-page-url
- %guix-bug-report-address))
- #:use-module ((guix ui) #:select (G_))
+ #:use-module ((guix i18n) #:select (G_))
+ #:use-module ((guix ui) #:select (show-version-and-exit
+ show-bug-report-information))
#:use-module (guix scripts)
#:use-module (sqlite3)
#:use-module (ice-9 match)
@@ -312,22 +311,6 @@ (define default-db-path
(string-append (cache-directory #:ensure? #f)
"/index/db.sqlite"))
-(define (show-bug-report-information)
- ;; TRANSLATORS: The placeholder indicates the bug-reporting address for this
- ;; package. Please add another line saying "Report translation bugs to
- ;; ...\n" with the address for translation bugs (typically your translation
- ;; team's web or email address).
- (format #t (G_ "
-Report bugs to: ~a.") %guix-bug-report-address)
- (format #t (G_ "
-~a home page: <~a>") %guix-package-name %guix-home-page-url)
- (format #t (G_ "
-General help using Guix and GNU software: <~a>")
- ;; TRANSLATORS: Change the "/en" bit of this URL appropriately if
- ;; the web site is translated in your language.
- (G_ "https://guix.gnu.org/en/help/";))
- (newline))
-
(define (show-help)
(display (G_ "Usage: guix index [OPTIONS...] [search FILE...]
Without argument, indexes (package, file) relationships in the local store.
--
2.38.1
From ea1d8216bfe5f487de24d883891b6e07c8536cdd Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Sun, 4 Dec 2022 16:01:33 +0100
Subject: [PATCH 15/18] extensions-index: Drop dead code we read from local
profiles now
---
guix/extensions/index.scm | 42 ++-------------------------------------
1 file changed, 2 insertions(+), 40 deletions(-)
diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm
index c40edc7944..a7c518e903 100644
--- a/guix/extensions/index.scm
+++ b/guix/extensions/index.scm
@@ -160,38 +160,6 @@ (define (strip file)
directories)))
(sqlite-exec db "commit;"))
-(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 (filter-public-current-supported package)
- "Filter supported, not hidden (public) and not superseded (current) package."
- (and (not (hidden-package? package))
- (not (package-superseded package))
- (supported-package? package)))
-
-(define (filter-supported-package package)
- "Filter supported package (package might be hidden or superseded)."
- (and (supported-package? package)))
-
-(define (no-filter package) "No filtering on package" #t)
-
-(define* (insert-packages db #:optional (filter-policy
filter-public-current-supported))
- "Insert all current packages matching `filter-package-policy` into DB."
- (with-store store
- (parameterize ((%graft? #f))
- (fold-packages (lambda (package _)
- (run-with-store store
- (insert-package db package)))
- #t
- #:select? filter-policy))))
-
;;;
;;; Indexing from local profiles.
@@ -209,7 +177,7 @@ (define (all-profiles)
(gc-roots))))
(define (profiles->manifest-entries profiles)
- "Return manifest entries for all of PROFILES, without duplicates."
+ "Return deduplicated manifest entries across all PROFILES."
(let loop ((visited (set))
(profiles profiles)
(entries '()))
@@ -286,12 +254,6 @@ (define lookup-stmt
;;; CLI
;;;
-(define (index-packages-with-db db-pathname)
- "Index packages using db at location DB-PATHNAME."
- (call-with-database db-pathname
- (lambda (db)
- (insert-packages db no-filter))))
-
(define (matching-packages-with-db db-pathname file)
"Compute list of packages referencing FILE using db at DB-PATHNAME."
(call-with-database db-pathname
@@ -358,7 +320,7 @@ (define (display-help-and-exit)
((db-path-args)
(let ((db-path (parse-db-args db-path-args)))
(if db-path
- (index-packages-with-db db-path)
+ (index-manifests db-path)
(display-help-and-exit))))
(("search" file)
(let ((matches (matching-packages-with-db default-db-path file)))
--
2.38.1
From 8454f9f417c2781fded2c26a1b920174991ac1dc Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Sun, 4 Dec 2022 16:12:10 +0100
Subject: [PATCH 16/18] extensions-index: Rework docstrings
---
guix/extensions/index.scm | 7 +++----
1 file changed, 3 insertions(+), 4 deletions(-)
diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm
index a7c518e903..1c23d9a4f1 100644
--- a/guix/extensions/index.scm
+++ b/guix/extensions/index.scm
@@ -166,7 +166,7 @@ (define (strip file)
;;;
(define (all-profiles)
- "Return the list of profiles on the system."
+ "Return the list of system profiles."
(delete-duplicates
(filter-map (lambda (root)
(if (file-exists? (string-append root "/manifest"))
@@ -200,14 +200,13 @@ (define (profiles->manifest-entries profiles)
(loop visited rest entries))))))
(define (insert-manifest-entry db entry)
- "Insert ENTRY, a manifest entry, into DB."
+ "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-manifests db-file)
- "Insert into DB-FILE entries for packages that appear in manifests
-available on the system."
+ "Insert packages entries into DB-FILE from the system manifests."
(call-with-database db-file
(lambda (db)
(for-each (lambda (entry)
--
2.38.1
From 98f9899d479cd62e93b86fab3448b2024db02621 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Sun, 4 Dec 2022 16:12:24 +0100
Subject: [PATCH 17/18] extensions-index: Fix warning according to repl
suggestion
---
guix/extensions/index.scm | 1 +
1 file changed, 1 insertion(+)
diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm
index 1c23d9a4f1..42c2051f13 100644
--- a/guix/extensions/index.scm
+++ b/guix/extensions/index.scm
@@ -23,6 +23,7 @@ (define-module (guix extensions index)
#:use-module (guix scripts)
#:use-module (sqlite3)
#:use-module (ice-9 match)
+ #:use-module (ice-9 format)
#:use-module (guix describe)
#:use-module (guix store)
#:use-module (guix monads)
--
2.38.1
From bb80ad696e1a47651f2dc4a7c74ea577372c61b5 Mon Sep 17 00:00:00 2001
From: "Antoine R. Dumont (@ardumont)" <antoine.romain.dumont@gmail.com>
Date: Sun, 4 Dec 2022 16:20:01 +0100
Subject: [PATCH 18/18] extensions-index: Ensure directory holding the db is
created
if needed. The creation is ignore if already present.
---
guix/extensions/index.scm | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm
index 42c2051f13..627dddc119 100644
--- a/guix/extensions/index.scm
+++ b/guix/extensions/index.scm
@@ -208,6 +208,10 @@ (define (insert-manifest-entry db entry)
(define (index-manifests db-file)
"Insert packages entries into DB-FILE from the system manifests."
+ (let ((db-dirpath (dirname db-file)))
+ (unless (file-exists? db-dirpath)
+ (mkdir db-dirpath)))
+
(call-with-database db-file
(lambda (db)
(for-each (lambda (entry)
--
2.38.1
============================================================
===File ~/repo/private/org/guix/guix-extensions-index.org===
#+title: Bootstrap guix index (search)
#+author: civodul, ardumont
Let's have a means to lookup from file to package holding that file:
* sources
-
[[https://lists.gnu.org/archive/html/guix-devel/2022-01/msg00354.html][Initial
discussion]]
- [[https://web.fdn.fr/~lcourtes/pastebin/file-database.scm.html][Latest
source]]
-
[[https://fulbert.neocities.org/guix/10-years-of-guix/simon-tournier-guix-repl/guix-cookbook/minimal-example.html][Extension
mechanism]] +
[[https://10years.guix.gnu.org/video/guix-repl-to-infinity-and-beyond/][demo
presentation]]
- [[https://issues.guix.gnu.org/58339][Simple extension package]]
* kickoff discussion to propose contribution in irc
#+begin_src txt
11:54 <ardumont> civodul: hello, i had a look at the discussion you pointed me
(on store "file search"), it's definitely interesting (and the offline part is
really what i need)
11:54 <ardumont> what's a way forward?
11:54 <ardumont> (if any)
11:55 <ardumont> (can i help or something? ;)
11:56 <ardumont> (i'm a somewhat "miscelleanous" lisper so)
12:01 <civodul> ardumont: hi! sure! i guess you could champion discussions &
development of such a tool
12:02 <civodul> so it's mostly about finding out how to make the info available
12:03 <civodul> perhaps there could be a default mode of operation downloading
the database from some server
12:03 <civodul> and an other mode of operation where it'd use purely local
knowledge
12:03 <ardumont> regarding the implementation, the end discussion talked about
compression, is that solely in regards to serving the result from somewhere?
12:03 <civodul> yes
12:03 <civodul> otherwise it doesn't really matter
12:03 <ardumont> (or is that some implementation adaptation so the tool is
doing it?)
12:03 <ardumont> i have my answer ;)
12:04 <civodul> this is the latest version i have:
https://web.fdn.fr/~lcourtes/pastebin/file-database.scm.html
12:05 <ardumont> thx, where should that live?
12:06 <ardumont> (in the end i mean) in the guix repo in a branch?
12:07 <ardumont> (we can always sort out the details of what's there to do
regarding licenses and whatnot, i'll comply to whatever is required)
12:17 <zimoun> hey ardumont :-)
12:17 <ardumont> civodul: no promise on eta yet but i'll check what i can do (i
got one last question below your last answer, sorry, i had forgotten to
highlight you ;)
12:17 <ardumont> hello zimoun ;)
12:17 <zimoun> civodul: the link fails for me
12:17 <civodul> ardumont: in the end it would be part of Guix
12:17 <civodul> that's the kind of tool that's generally useful
12:17 <ardumont> yes
12:17 <zimoun> or via an extension?
12:18 <zimoun> civodul: -^
12:18 <ardumont> i was gonna ask, is guix providing a way to extend the guix
cli through extension already?
12:18 <civodul> it can start its life as an extension, sure
12:18 <ardumont> (since it's lisp and all that, somehow that makes sense to me
;)
12:18 <civodul> but the way i see it it should be part of Guix proper at some
point
12:18 <zimoun> ardumont: yes, exemples are here
https://issues.guix.gnu.org/58463
12:19 <ardumont> nice
12:19 <civodul> zimoun demoed extensions at the 10 years :-)
12:19 <civodul> yep
12:19 <ardumont> (oh i missed it, i was not there yet)
12:19 <ardumont> (or already left ¯\_(ツ)_/¯)
12:19 <zimoun>
https://10years.guix.gnu.org/video/guix-repl-to-infinity-and-beyond/
12:20 <ardumont> i like that title ;)
12:20 <ardumont> (thx)
12:21 <zimoun> civodul: I think we should go a path where we have more
extensions and less all-in subcommands. For sure, tradeoff with maintenance.
:-)
12:21 <ardumont> yes, that'd make sense ^
#+end_src
* Some Metrics
** iteration 1 (over nix store)
*** guixified debian
yavin4:
#+begin_src sh
$ time guix index
;;; (package 286 "xcb-util-renderutil")
guix index 121.88s user 2.49s system 138% cpu 1:29.82 total
$ sqlite3 ~/.config/guix/locate-db.sqlite
SQLite version 3.34.1 2021-01-20 14:10:07
Enter ".help" for usage hints.
sqlite> select count(*) from files; select count(*) from directories; select
count(*) from packages;
50913
328
284
$ ls -lah ~/.config/guix/locate-db.sqlite
-rw-r--r-- 1 tony tony 8.9M Dec 3 10:49
/home/tony/.config/guix/locate-db.sqlite
#+end_src
*** guix system node
dagobah:
#+begin_src sh
$ time guix index
;;; (package 1 "acl")
;;; (package 2 "inetutils")
...
;;; (package 753 "xauth")
guix index 413.55s user 6.16s system 124% cpu 5:36.67 total
$ ls -lah ~/.config/guix/locate-db.sqlite
-rw-r--r-- 1 tony users 30M Dec 3 10:42
/home/tony/.config/guix/locate-db.sqlite
$ sqlite3 ~/.config/guix/locate-db.sqlite
SQLite version 3.39.3 2022-09-05 11:02:23
Enter ".help" for usage hints.
sqlite> select count(*) from files; select count(*) from directories; select
count(*) from packages;
162035
830
749
#+end_src
** iteration 2 (over system manifests)
*** guixified debian
#+begin_src sh
$ time guix index
;;; (package 110 "guix")
guix index 1.30s user 0.34s system 94% cpu 1.735 total
$ sqlite3 ~/.cache/guix/index/db.sqlite
SQLite version 3.34.1 2021-01-20 14:10:07
Enter ".help" for usage hints.
sqlite> select count(*) from files; select count(*) from directories; select
count(*) from packages;
34339
110
101
ls -lah ~/.cache/guix/index/db.sqlite
-rw-r--r-- 1 tony tony 5.8M Dec 4 16:22 /home/tony/.cache/guix/index/db.sqlite
#+end_src
*** guix host
#+begin_src sh
$ time guix index
;;; (package 515 "guix")
guix index 11.54s user 2.22s system 87% cpu 15.693 total
dagobah% sqlite3 ~/.cache/guix/index/db.sqlite
SQLite version 3.39.3 2022-09-05 11:02:23
Enter ".help" for usage hints.
sqlite> select count(*) from files; select count(*) from directories; select
count(*) from packages;
152947
515
354
sqlite> .quit
dagobah% ls -lah ~/.cache/guix/index/db.sqlite
-rw-r--r-- 1 tony users 29M Dec 4 16:26 /home/tony/.cache/guix/index/db.sqlite
#+end_src
============================================================
signature.asc
Description: PGP signature
- Re: File search, antoine . romain . dumont, 2022/12/02
- Re: File search, Antoine R. Dumont (@ardumont), 2022/12/02
- Re: File search, Ludovic Courtès, 2022/12/03
- Re: File search, Antoine R. Dumont (@ardumont), 2022/12/09
- Re: File search, zimoun, 2022/12/09
- Re: File search, Ludovic Courtès, 2022/12/11
- Re: File search, Antoine R. Dumont (@ardumont), 2022/12/15
- Re: File search, Ludovic Courtès, 2022/12/19
- Re: File search, zimoun, 2022/12/19