From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id aKvHEDVdm2P2cgEAbAwnHQ (envelope-from ) for ; Thu, 15 Dec 2022 18:45:25 +0100 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id oEfkEDVdm2PFggEA9RJhRA (envelope-from ) for ; Thu, 15 Dec 2022 18:45:25 +0100 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 9C2512A2BA for ; Thu, 15 Dec 2022 18:45:24 +0100 (CET) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1p5rdo-0005eC-OY; Thu, 15 Dec 2022 12:03:28 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1p5rda-0005b2-PQ for guix-devel@gnu.org; Thu, 15 Dec 2022 12:03:17 -0500 Received: from mail-wm1-x32f.google.com ([2a00:1450:4864:20::32f]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1p5rdV-0003JG-4V; Thu, 15 Dec 2022 12:03:14 -0500 Received: by mail-wm1-x32f.google.com with SMTP id m19so14282415wms.5; Thu, 15 Dec 2022 09:03:04 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=mime-version:message-id:date:references:in-reply-to:subject:cc:to :from:from:to:cc:subject:date:message-id:reply-to; bh=BzvSyG7x/kvE8tvYulpNFURhEMrVC2GQvMhtLHuDypY=; b=DatQIDO2hcteID5NSpa4NaYfbMbAioFuxS381uHLusu+VrA10UlS6jQlf9p9EWUvJY igmApVyVA2yDSePRcKenVnzu4KUWoCK3g0qhWyXQn2n9yjK5pZcB+TJvPmiJH0vXnI7b Ue6h0CGc3XB5pps5jjwVpp7GWW1IygCAgCXDbwOoVKsU17H4UiWf1G1zSPz1nAm5qWtI FEPdBK4koiU/OIY7NrpE2QZf1F9R8rjGwBVnDouOEtd4R2pGOVs32EYpVrYGopSUpe96 ZIa1B0BwYlCEtcDCP3P3r09c40uwhyJ1VeB1OhfWFhVQcBd6cumGeWPsLMwK8oup/CzR 4vIQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=mime-version:message-id:date:references:in-reply-to:subject:cc:to :from:x-gm-message-state:from:to:cc:subject:date:message-id:reply-to; bh=BzvSyG7x/kvE8tvYulpNFURhEMrVC2GQvMhtLHuDypY=; b=b34F2a1Vpp194DRKnsuyMi+p3Gy1I2nx2Wjec8kZHh9nQphQb6mFRtGxsYUL68EFvV ekNujNQRTlR6uH5AfhqR1GTDYiOo/syBKueAgxZPs2gRj6QKI+XnXSR8DREcV2lHC4Qj zsr3VMMvHdHysuhwmPVpeANmbvpsAKc8zDRe8uxDVDn+yer7WMNv2p9I8j0VDxHA8vf+ J9cyfWySzPJRW37ohGUkIRRfQZ912g0/72JZwbdesPLYMWOy7XAWsBXvDokh56Ur5HMQ luVUhXgf7zjp+1rkc4cR+qvNsjZOiRbOb8rfzUr5KO9cZ6ArYBjz8c7mD3kBMY/cjbve hIlw== X-Gm-Message-State: ANoB5pm4RmqUY2UeovjCpWldPWPxE+QSb6/HXFbWu4FgZGW/WWWfU28F 5krEYumgXjLJai75cSpkG4zI1MkIV2g= X-Google-Smtp-Source: AA0mqf6itlFpXFW66HIWXutKQFcETppTc2asm3ptETaV9W1GFFsshkKC+A77Onl3D5Wq22a6ap16gg== X-Received: by 2002:a05:600c:6002:b0:3cf:8260:6364 with SMTP id az2-20020a05600c600200b003cf82606364mr23575697wmb.37.1671123783063; Thu, 15 Dec 2022 09:03:03 -0800 (PST) Received: from yavin4 ([2a01:e0a:1c8:8a40:2394:a743:1507:85ab]) by smtp.gmail.com with ESMTPSA id f127-20020a1c3885000000b003b3307fb98fsm6768551wma.24.2022.12.15.09.03.02 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 15 Dec 2022 09:03:02 -0800 (PST) From: "Antoine R. Dumont (@ardumont)" To: Ludovic =?utf-8?Q?Court=C3=A8s?= Cc: guix-devel@gnu.org Subject: Re: File search In-Reply-To: <87v8mi2q9t.fsf@gnu.org> References: <87pmd1r8kt.fsf@gmail.com> <87mt85r7h8.fsf@gmail.com> <87lenonydz.fsf@gnu.org> <877cz7qg80.fsf@gmail.com> <878rjkn949.fsf@gnu.org> <87pmcsriwu.fsf@gmail.com> <87v8mi2q9t.fsf@gnu.org> Date: Thu, 15 Dec 2022 18:03:01 +0100 Message-ID: <87pmck7g6y.fsf@gmail.com> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" Received-SPF: pass client-ip=2a00:1450:4864:20::32f; envelope-from=antoine.romain.dumont@gmail.com; helo=mail-wm1-x32f.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_FILL_THIS_FORM_SHORT=0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guix-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+larch=yhetil.org@gnu.org Sender: guix-devel-bounces+larch=yhetil.org@gnu.org X-Migadu-Flow: FLOW_IN X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1671126325; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=3ct3dIFMu9ZFXIh/z2gnA0y6LeTqOyfUrFjLA7rWVcQ=; b=N8Npkgp5tND+XRLDqFNbZowMzUHVR1zcuxyz538+ODM7J5fx3y93gFyE0clJE+ExQaxoCj 4uW7LikLaCh4uA0nqjswcaDqRA+hGo5x6NYDcb1O0Z5NeYkC8mAjbsukF1FsilloyfQtOG +DJQHmFWC8TFnQtRl+9LTcM+JBuEUaiwxWmFsAQoN8lhIJDwytPPWqgdU2R7GMheibx0mC jF4TlF1C5fpBClzek3iQ8xc3GMgINx0NUebLc8qTA42ZicI+qDMXUt7KtkZcvZiDRLzsrM hjQ1P9g6feW0FOgWnLVBEwYSEyAMh0dIZK8xuUk2MDbxTowm7oaPhoWjK0D30w== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gmail.com header.s=20210112 header.b=DatQIDO2; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none); spf=pass (aspmx1.migadu.com: domain of "guix-devel-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-devel-bounces+larch=yhetil.org@gnu.org" ARC-Seal: i=1; s=key1; d=yhetil.org; t=1671126325; a=rsa-sha256; cv=none; b=ehG7MNOPLunaztsaOCv/kYMsdXwZteiIetJUm1Kgyt0HKQrYsintI2uXGtP+8TwyORCHbW LLQjjaiG5FLptXq0A4f4VMNLiO9IQX7uesuXhMSUu69OGw1kggz8lRMyrRzl0z6PCrgdH2 djUmDUzohhH0qyspcxOsWIGFeXL7hBw0U9GSLeEQ0HvwFYlhAGudI/R+8/nMcOSjnbQRrs vkR3motMra1+aTD9swOZSKfty9XcxogdYo0BPktHWLcmo++WkACOoxMupHZfTCPJwER99r 3ovXdsQ6hve+owrCZb/pOJYzxxjPVNYDWLTXtmtM/xqmv6/mPBgg3rAZQ9SK6A== X-Spam-Score: 5.72 X-Migadu-Queue-Id: 9C2512A2BA X-Migadu-Scanner: scn1.migadu.com Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gmail.com header.s=20210112 header.b=DatQIDO2; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none); spf=pass (aspmx1.migadu.com: domain of "guix-devel-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-devel-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: 5.72 X-TUID: KRbhNJdkO/1c --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello, As mentioned last week (on irc), I've improved a bit the implementation as per the last discussions in the thread. Please, find enclosed the patch with those changes (hopefully a tad better attached than last time...). Here is the rough changelog: =2D The local db cache is now versioned. Migration will transparently happen for users at each index command calls (if need be). Note: Care should be taken by devs to provide the migration script step for each db schema bump (examples inside). The rest will happen on its own. =2D The cli parsing got rewritten to be more flexible (inspired from existing code from guix, notably `guix home`). =2D We can now choose the indexation method using the `--with-method=3D{store|manifests}` flag. The "manifests" method is the default, seel the help message for more details). =2D Finally, the indexation methods are displayed using a progress bar. Heads up, I did not yet address the "output" part. Thanks @zimoun for the clarification btw ;) > In the package case, the number of packages is known ahead. @civodul For the index 'store' implementation, ^ I did not find that information. So, as a costly implementation detail, I'm folding over all packages first to know the total number of packages (for the progress bar). And then another round trip to actually do the insert. I don't like it at all. Plus, that number seems off to me (21696) packages in regards to the number of packages indexed (522). So, if you could have a rapid look to fix or tell me what's wrong, that'd be great. I'm pretty sure it will hit you immediately (while i still do not find it =C2=AF\_(=E3=83=84)_/=C2=AF ;). =2D--- Here is a rapid sample of the current command usage: =2D-8<---------------cut here---------------end--------------->8--- $ guix index --version Extension local cache database: =2D path: /home/tony/.cache/guix/index/db.sqlite =2D version: 2 guix index (GNU Guix) 5ccb5837ccfb39af4e3e6399a0124997a187beb1 Copyright (C) 2022 the Guix authors License GPLv3+: GNU GPL version 3 or later This is free software: you are free to change and redistribute it. There is NO WARRANTY, to the extent permitted by law. $ guix index --with-method=3Dstore --db-path=3D/tmp/db/db.sqlite Registering 21696 packages [######## ] $ guix index search git ... git-minimal@2.38.1 /gnu/store/xf734fz3jihgc5x4979ypyaxn8aday1k-git-minima= l-2.38.1/bin/git git@2.38.1 /gnu/store/wx965ym3c5fwbcdp7i9lvzad3479vv7m-git-2.38.1= /libexec/git-core/git git@2.38.1 /gnu/store/wx965ym3c5fwbcdp7i9lvzad3479vv7m-git-2.38.1= /etc/bash_completion.d/git git@2.38.1 /gnu/store/wx965ym3c5fwbcdp7i9lvzad3479vv7m-git-2.38.1/bin/git $ guix index --help Usage: guix index [OPTIONS...] [search FILE...] Without argument, indexes (package, file) relationships from the machine. This allows indexation with 2 methods: =2D out of the local manifests. This is the fastest implementation but this indexes less packages. That'd be typically the use case for user local indexation. =2D out of the local store. This is slower due to implementation details (it discusses with the store daemon for one). That'd be typically the use case = for 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=3DDIR Change default location of the cache db --with-method=3DMETH Change default indexation method. By default it use= s 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) 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: General help using Guix and GNU software: =2D-8<---------------cut here---------------end--------------->8--- Hope you'll find it mostly to your taste! Note: I gather we'll rework the commits at some point (when it's ready) so I did not bother too much right now. Cheers, =2D- tony / Antoine R. Dumont (@ardumont) =2D---------------------------------------------------------------- gpg fingerprint BF00 203D 741A C9D5 46A8 BE07 52E2 E984 0D10 C3B8 --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=add-extension-guix-index.patch Content-Transfer-Encoding: quoted-printable From=20d3e658ca1e3ce2715e25450b794d139d3417c74c Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Ludovic=3D20Court=3DC3=3DA8s?=3D Date: Wed, 30 Nov 2022 15:25:21 +0100 Subject: [PATCH 01/25] extensions-index: Add initial implementation from civodul Related to https://lists.gnu.org/archive/html/guix-devel/2022-01/msg00354.h= tml =2D-- 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-datab= ase.scm new file mode 100644 index 0000000000..83aafbc554 =2D-- /dev/null +++ b/guix/extensions/file-database.scm @@ -0,0 +1,199 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2022 Ludovic Court=C3=A8s +;;; +;;; 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 . + +(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 single= ton. + (unless (string=3D? file directory) + (sqlite-reset file-stmt) + (sqlite-bind-arguments file-stmt + #:name (strip fil= e) + #: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 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 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 =3D :file AND directories.id =3D files.directory AND pac= kages.id =3D 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 resul= t)) + (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)) =2D-=20 2.38.1 From=20d9139cc86c26f76bc66f7d82868ebf6a03605f76 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Thu, 1 Dec 2022 13:36:28 +0100 Subject: [PATCH 02/25] extensions-index: Transform command into `guix locat= e` extension =2D-- .../{file-database.scm =3D> locate.scm} | 58 ++++++++++++------- 1 file changed, 36 insertions(+), 22 deletions(-) rename guix/extensions/{file-database.scm =3D> 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 =2D-- 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 . =20 =2D(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) =2D #:export (file-database)) + #:export (guix-locate)) =20 (define schema " @@ -155,8 +156,7 @@ (define-record-type (file package-match-file)) =20 (define (matching-packages db file) =2D "Return a list of corresponding to packages containing =2DFILE." + "Return list of corresponding to packages containing FIL= E." (define lookup-stmt (sqlite-prepare db "\ SELECT Packages.name, Packages.version, Directories.name, Files.name @@ -174,26 +174,40 @@ (define lookup-stmt '() lookup-stmt)) =20 =2D(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 =2D ((_ "populate") =2D (call-with-database "/tmp/db" =2D (lambda (db) =2D (insert-packages db)))) =2D ((_ "search" file) =2D (let ((matches (call-with-database "/tmp/db" =2D (lambda (db) =2D (matching-packages db file))))) =2D (for-each (lambda (result) =2D (format #t "~20a ~a~%" =2D (string-append (package-match-name result) =2D "@" (package-match-version res= ult)) =2D (package-match-file result))) =2D 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) =2D "usage: file-database [populate|search] args ...~%") + "usage: guix locate [index|search] args ...~% ~a" + args) (exit 1)))) =2D =2D(apply file-database (command-line)) =2D-=20 2.38.1 From=20eb474f3412ba19320dceda7d08c7f960d00cb898 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Thu, 1 Dec 2022 13:45:59 +0100 Subject: [PATCH 03/25] extensions-index: Avoid duplicating the hard-coded db path =2D-- 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 =2D-- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -196,14 +196,18 @@ (define (print-matching-results matches) (package-match-file result))) matches)) =20 +;; TODO: Determine the current guile/guix mechanism to provide configurati= on +;; 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") =2D (index-packages-with-db "/tmp/db")) + (index-packages-with-db default-location-db-path)) (("search" file) =2D (let ((matches (matching-packages-with-db "/tmp/db" file))) + (let ((matches (matching-packages-with-db default-location-db-path fi= le))) (print-matching-results matches) (exit (pair? matches)))) (_ =2D-=20 2.38.1 From=20309ecd5d5b7cdff012b66cbe9643c34725b22a2d Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Thu, 1 Dec 2022 13:47:19 +0100 Subject: [PATCH 04/25] extensions-index: Deduplicate lookup matching results =2D-- 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 =2D-- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -156,10 +156,10 @@ (define-record-type (file package-match-file)) =20 (define (matching-packages db file) =2D "Return list of corresponding to packages containing F= ILE." + "Return unique corresponding to packages containing FILE= ." (define lookup-stmt (sqlite-prepare db "\ =2DSELECT Packages.name, Packages.version, Directories.name, Files.name +SELECT DISTINCT Packages.name, Packages.version, Directories.name, Files.n= ame FROM Packages INNER JOIN Files, Directories ON files.basename =3D :file AND directories.id =3D files.directory AND pac= kages.id =3D directories.package;")) =2D-=20 2.38.1 From=20541615ab6638b1fb418531f961cfb6756b41499b Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 14:09:52 +0100 Subject: [PATCH 05/25] 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. =2D-- 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 =2D-- 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, =2D version text not null + version text not null, + unique (name, version) -- add uniqueness constraint ); =20 create table if not exists Directories ( id integer primary key autoincrement not null, name text not null, package integer not null, =2D foreign key (package) references Packages(id) on delete cascade + foreign key (package) references Packages(id) on delete cascade, + unique (name, package) -- add uniqueness constraint ); =20 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 ); =20 create index if not exists IndexFiles on Files(basename);") @@ -66,64 +69,78 @@ (define (call-with-database file proc) (sqlite-close db))))) =20 (define (insert-files db package version directories) =2D "Insert the files contained in DIRECTORIES as belonging to PACKAGE at =2DVERSION." =2D (define last-row-id-stmt =2D (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 =3D :name AND version =3D :version;" #:cache? #t)) =20 =2D (define package-stmt + (define stmt-insert-package (sqlite-prepare db "\ =2DINSERT OR REPLACE INTO Packages(name, version) +INSERT OR IGNORE INTO Packages(name, version) -- to avoid spurious writes VALUES (:name, :version);" #:cache? #t)) =20 =2D (define directory-stmt + (define stmt-select-directory (sqlite-prepare db "\ =2DINSERT INTO Directories(name, package) VALUES (:name, :package);" +SELECT id FROM Directories WHERE name =3D :name AND package =3D :package;" #:cache? #t)) =20 =2D (define file-stmt + (define stmt-insert-directory (sqlite-prepare db "\ =2DINSERT INTO Files(name, basename, directory) +INSERT OR IGNORE INTO Directories(name, package) -- to avoid spurious writ= es +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)) =20 (sqlite-exec db "begin immediate;") =2D (sqlite-bind-arguments package-stmt + (sqlite-bind-arguments stmt-insert-package #:name package #:version version) =2D (sqlite-fold (const #t) #t package-stmt) =2D (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))) =20 =2D (sqlite-reset directory-stmt) =2D (sqlite-bind-arguments directory-stmt + (sqlite-reset stmt-insert-directory) + (sqlite-bind-arguments stmt-insert-directory #:name directory #:package package-id) =2D (sqlite-fold (const #t) #t directory-stmt) + (sqlite-fold (const #t) #t stmt-insert-directory) =20 =2D (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 single= ton. (unless (string=3D? file directory) =2D (sqlite-reset file-stmt) =2D (sqlite-bind-arguments file-stmt + (sqlite-reset stmt-insert-file) + (sqlite-bind-arguments stmt-insert-file #:name (strip fil= e) #:basename (basename file) #:directory directory-id) =2D (sqlite-fold (const #t) #t file-stmt))) + (sqlite-fold (const #t) #t stmt-insert-f= ile))) (find-files directory))))) =2D directories) =2D (sqlite-exec db "commit;")))) + directories))) + (sqlite-exec db "commit;")) =20 (define (insert-package db package) "Insert all the files of PACKAGE into DB." @@ -159,10 +176,12 @@ (define (matching-packages db file) "Return unique corresponding to packages containing FILE= ." (define lookup-stmt (sqlite-prepare db "\ =2DSELECT DISTINCT Packages.name, Packages.version, Directories.name, Files= .name +SELECT Packages.name, Packages.version, Directories.name, Files.name FROM Packages INNER JOIN Files, Directories =2DON files.basename =3D :file AND directories.id =3D files.directory AND p= ackages.id =3D directories.package;")) +ON files.basename =3D :file + AND directories.id =3D files.directory + AND packages.id =3D directories.package;")) =20 (sqlite-bind-arguments lookup-stmt #:file file) (sqlite-fold (lambda (result lst) =2D-=20 2.38.1 From=2009d5f6b30ac24a8e8261994a1011ddd13082a4bb Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 14:10:59 +0100 Subject: [PATCH 06/25] extensions-index: Add debug statement This is conditional in the top-level debug module variable, false by defaul= t. =2D-- 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 =2D-- 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)) =20 +(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 single= ton. =2D-=20 2.38.1 From=20b50267e3d24162cd8c3908bbaa841d13363621e9 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 14:11:50 +0100 Subject: [PATCH 07/25] 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. =2D-- 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 =2D-- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -160,18 +160,27 @@ (define (insert-package db package) directories)) (return #t))))) =20 =2D(define (insert-packages db) =2D "Insert all the current packages into DB." +(define (filter-public-current-supported package) + "Filter supported, not hidden (public) and not superseded (current) pack= age." + (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-curre= nt-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 =2D #:select? (lambda (package) =2D (and (not (hidden-package? package)) =2D (not (package-superseded package)) =2D (supported-package? package))))))) + #:select? filter-policy)))) =20 (define-record-type (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) =2D (insert-packages db)))) + (insert-packages db no-filter)))) =20 (define (matching-packages-with-db db-pathname file) "Compute list of packages referencing FILE using db at DB-PATHNAME." =2D-=20 2.38.1 From=203b5c765fc967cef1d6919b66acc2d7872ea1e48c Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 15:19:24 +0100 Subject: [PATCH 08/25] extensions-index: Install db in ~/.config/guix/locate-db.sqlite =2D-- 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 =2D-- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -232,9 +232,12 @@ (define (print-matching-results matches) (package-match-file result))) matches)) =20 =2D;; TODO: Determine the current guile/guix mechanism to provide configura= tion =2D;; for this =2D(define default-location-db-path "/tmp/db") +(define default-location-db-path + (let ((local-config-path + (and=3D> (getenv "HOME") + (lambda (home) + (string-append home "/.config/guix/"))))) + (string-append local-config-path "locate-db.sqlite"))) =20 (define-command (guix-locate . args) (category extension) =2D-=20 2.38.1 From=20f101d12acf05c82cf9678d1cffec76cceba9e845 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 17:58:18 +0100 Subject: [PATCH 09/25] extensions-index: Improve cli parsing This unifies with some existing guix commands (import). =2D-- 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 =2D-- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -17,9 +17,12 @@ ;;; along with GNU Guix. If not, see . =20 (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)) =20 =2D(define default-location-db-path +(define default-db-path (let ((local-config-path (and=3D> (getenv "HOME") (lambda (home) (string-append home "/.config/guix/"))))) (string-append local-config-path "locate-db.sqlite"))) =20 +(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 translat= ion + ;; 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.sqli= te. +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=3DDIR 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) =2D (synopsis "Index packages then search what package declares a given fi= le") + (synopsis "Index packages to allow searching package for a given filenam= e") + + (define (parse-db-args args) + "Parsing of string key=3Dvalue where we are only interested in 'value= '" + (match (string-split args #\=3D) + ((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") =2D (index-packages-with-db default-location-db-path)) + (index-packages-with-db default-db-path)) (("search" file) =2D (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)))) =2D (_ =2D (format (current-error-port) =2D "usage: guix locate [index|search] args ...~% ~a" =2D args) =2D (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)))))) =2D-=20 2.38.1 From=209cb0826a71bdada345de100d98e9b44f3503a75a Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 19:13:46 +0100 Subject: [PATCH 10/25] extensions-index: Improve cli options and help messa= ge This also renames the cli from locate to index. =2D-- guix/extensions/{locate.scm =3D> index.scm} | 40 +++++++++++++---------- 1 file changed, 22 insertions(+), 18 deletions(-) rename guix/extensions/{locate.scm =3D> 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 =2D-- 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 . =20 =2D(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) =2D #:export (guix-locate)) + #:export (guix-index)) =20 (define debug #f) =20 @@ -259,26 +259,30 @@ (define (show-bug-report-information) (newline)) =20 (define (show-help) =2D (display (G_ "Usage: guix locate [OPTIONS...] [ARGS...] =2DIndex packages and search what package declares a given file.\n =2DBy default, the local cache db is located in ~/.config/guix/locate-db.sq= lite. =2DSee --db-path for customization.")) =2D (display (G_ " =2D index Index current packages from the local store (in cache = db)")) =2D (display (G_ " =2D 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) =2D (display (G_ " =2D --db-path=3DDIR 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=3DDIR 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)) =20 =2D(define-command (guix-locate . args) +(define-command (guix-index . args) (category extension) (synopsis "Index packages to allow searching package for a given filenam= e") =20 @@ -294,17 +298,15 @@ (define (display-help-and-exit) (exit 0)) =20 (match args =2D ((or ("-h") ("--help") ()) + ((or ("-h") ("--help")) (display-help-and-exit)) ((or ("-V") ("--version")) (show-version-and-exit "guix locate")) =2D ((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)))) =2D (("index") =2D (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))) =2D (display-help-and-exit)))))) + (display-help-and-exit)))) + (_ ;; index by default + (index-packages-with-db default-db-path)))) =2D-=20 2.38.1 From=20f18d1f536bf6b13ec0dd8ee1e865ce21448e3836 Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Ludovic=3D20Court=3DC3=3DA8s?=3D Date: Sun, 4 Dec 2022 14:42:45 +0100 Subject: [PATCH 11/25] extensions-index: Iterate over system manifests to index This should avoid the extra work of discussing with daemon, computing derivations, etc... =2D-- 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 =2D-- 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)) =20 (define debug #f) @@ -185,6 +191,67 @@ (define* (insert-packages db #:optional (filter-policy= filter-public-current-sup #t #:select? filter-policy)))) =20 + +;;; +;;; 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 name version file) package-match? @@ -214,6 +281,10 @@ (define lookup-stmt =20 =20 +;;; +;;; 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)) =20 (define default-db-path =2D (let ((local-config-path =2D (and=3D> (getenv "HOME") =2D (lambda (home) =2D (string-append home "/.config/guix/"))))) =2D (string-append local-config-path "locate-db.sqlite"))) + (string-append (cache-directory #:ensure? #f) + "/index/db.sqlite")) =20 (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. =2DWith '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)))) =2D (_ ;; index by default =2D (index-packages-with-db default-db-path)))) + (_ ;; By default, index + (index-manifests default-db-path)))) =2D-=20 2.38.1 From=20c9b02fc838237ebd7bc38ba7a71587fcdcaf6212 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 14:45:20 +0100 Subject: [PATCH 12/25] extensions-index: Improve help message =2D-- 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 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -328,9 +328,9 @@ (define (show-bug-report-information) =20 (define (show-help) (display (G_ "Usage: guix index [OPTIONS...] [search FILE...] =2DWithout 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 =2DNote: 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:")) =2D-=20 2.38.1 From=20d63ef7a97f3fb47b5693b2c1d24bdf276ca6a6a8 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 14:46:04 +0100 Subject: [PATCH 13/25] extensions-index: Improve imports =2D-- 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 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -17,8 +17,10 @@ ;;; along with GNU Guix. If not, see . =20 (define-module (guix extensions index) =2D #:use-module (guix config) ;; %guix-package-name, ... =2D #: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) =2D-=20 2.38.1 From=2014a9dafb2b927ba8435a26fdea04b00644e3ca3c Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 15:52:15 +0100 Subject: [PATCH 14/25] extensions-index: Drop code duplication Import directly the right function from guix ui module. =2D-- 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 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -17,10 +17,9 @@ ;;; along with GNU Guix. If not, see . =20 (define-module (guix extensions index) =2D #:use-module ((guix config) #:select (%guix-package-name =2D %guix-home-page-url =2D %guix-bug-report-address)) =2D #: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")) =20 =2D(define (show-bug-report-information) =2D ;; TRANSLATORS: The placeholder indicates the bug-reporting address fo= r this =2D ;; package. Please add another line saying "Report translation bugs to =2D ;; ...\n" with the address for translation bugs (typically your transl= ation =2D ;; team's web or email address). =2D (format #t (G_ " =2DReport bugs to: ~a.") %guix-bug-report-address) =2D (format #t (G_ " =2D~a home page: <~a>") %guix-package-name %guix-home-page-url) =2D (format #t (G_ " =2DGeneral help using Guix and GNU software: <~a>") =2D ;; TRANSLATORS: Change the "/en" bit of this URL appropriately= if =2D ;; the web site is translated in your language. =2D (G_ "https://guix.gnu.org/en/help/")) =2D (newline)) =2D (define (show-help) (display (G_ "Usage: guix index [OPTIONS...] [search FILE...] Without argument, indexes (package, file) relationships in the local store. =2D-=20 2.38.1 From=20ea1d8216bfe5f487de24d883891b6e07c8536cdd Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 16:01:33 +0100 Subject: [PATCH 15/25] extensions-index: Drop dead code we read from local profiles now =2D-- 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 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -160,38 +160,6 @@ (define (strip file) directories))) (sqlite-exec db "commit;")) =20 =2D(define (insert-package db package) =2D "Insert all the files of PACKAGE into DB." =2D (mlet %store-monad ((drv (package->derivation package #:graft? #f))) =2D (match (derivation->output-paths drv) =2D (((labels . directories) ...) =2D (when (every file-exists? directories) =2D (insert-files db (package-name package) (package-version packag= e) =2D directories)) =2D (return #t))))) =2D =2D(define (filter-public-current-supported package) =2D "Filter supported, not hidden (public) and not superseded (current) pa= ckage." =2D (and (not (hidden-package? package)) =2D (not (package-superseded package)) =2D (supported-package? package))) =2D =2D(define (filter-supported-package package) =2D "Filter supported package (package might be hidden or superseded)." =2D (and (supported-package? package))) =2D =2D(define (no-filter package) "No filtering on package" #t) =2D =2D(define* (insert-packages db #:optional (filter-policy filter-public-cur= rent-supported)) =2D "Insert all current packages matching `filter-package-policy` into DB." =2D (with-store store =2D (parameterize ((%graft? #f)) =2D (fold-packages (lambda (package _) =2D (run-with-store store =2D (insert-package db package))) =2D #t =2D #:select? filter-policy)))) =2D ;;; ;;; Indexing from local profiles. @@ -209,7 +177,7 @@ (define (all-profiles) (gc-roots)))) =20 (define (profiles->manifest-entries profiles) =2D "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 ;;; =20 =2D(define (index-packages-with-db db-pathname) =2D "Index packages using db at location DB-PATHNAME." =2D (call-with-database db-pathname =2D (lambda (db) =2D (insert-packages db no-filter)))) =2D (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 =2D (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))) =2D-=20 2.38.1 From=208454f9f417c2781fded2c26a1b920174991ac1dc Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 16:12:10 +0100 Subject: [PATCH 16/25] extensions-index: Rework docstrings =2D-- 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 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -166,7 +166,7 @@ (define (strip file) ;;; =20 (define (all-profiles) =2D "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)))))) =20 (define (insert-manifest-entry db entry) =2D "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? =20 (define (index-manifests db-file) =2D "Insert into DB-FILE entries for packages that appear in manifests =2Davailable on the system." + "Insert packages entries into DB-FILE from the system manifests." (call-with-database db-file (lambda (db) (for-each (lambda (entry) =2D-=20 2.38.1 From=2098f9899d479cd62e93b86fab3448b2024db02621 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 16:12:24 +0100 Subject: [PATCH 17/25] extensions-index: Fix warning according to repl suggestion =2D-- 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 =2D-- 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) =2D-=20 2.38.1 From=20bb80ad696e1a47651f2dc4a7c74ea577372c61b5 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 16:20:01 +0100 Subject: [PATCH 18/25] extensions-index: Ensure directory holding the db is created if needed. The creation is ignore if already present. =2D-- 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 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -208,6 +208,10 @@ (define (insert-manifest-entry db entry) =20 (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) =2D-=20 2.38.1 From=2034a86f977947371d1eae3be9953190464aa01a8c Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 11 Dec 2022 20:11:56 +0100 Subject: [PATCH 19/25] extensions-index: Add a schema db version Nothing is done with that version just yet besides displaying it in the =2D-version call. =2D-- guix/extensions/index.scm | 179 ++++++++++++++++++++++++-------------- 1 file changed, 112 insertions(+), 67 deletions(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index 627dddc119..b89eb9e6c8 100644 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -44,8 +44,15 @@ (define-module (guix extensions index) =20 (define debug #f) =20 +(define application-version 1) + (define schema " +create table if not exists SchemaVersion ( + version integer primary key not null, + unique (version) +); + create table if not exists Packages ( id integer primary key autoincrement not null, name text not null, @@ -81,85 +88,107 @@ (define (call-with-database file proc) (lambda () (sqlite-close db))))) =20 =2D(define (insert-files db package version directories) =2D "Insert files from DIRECTORIES as belonging to PACKAGE at VERSION." =2D (define stmt-select-package +(define (insert-version db version) + "Insert application VERSION into the DB." + (define stmt-insert-version (sqlite-prepare db "\ =2DSELECT id FROM Packages WHERE name =3D :name AND version =3D :version;" +INSERT OR IGNORE INTO SchemaVersion(version) +VALUES (:version);" #: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;")) =20 =2D (define stmt-insert-package =2D (sqlite-prepare db "\ +(define (read-version db) + "Read the current application version from the DB." + + (define stmt-select-version (sqlite-prepare db "\ +SELECT version FROM SchemaVersion;" + #:cache? #t)) + (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 =3D :name AND version =3D :version;" + #:cache? #t)) + + (define stmt-insert-package + (sqlite-prepare db "\ INSERT OR IGNORE INTO Packages(name, version) -- to avoid spurious writes VALUES (:name, :version);" =2D #:cache? #t)) + #:cache? #t)) =20 =2D (define stmt-select-directory =2D (sqlite-prepare db "\ + (define stmt-select-directory + (sqlite-prepare db "\ SELECT id FROM Directories WHERE name =3D :name AND package =3D :package;" =2D #:cache? #t)) + #:cache? #t)) =20 =2D (define stmt-insert-directory =2D (sqlite-prepare db "\ + (define stmt-insert-directory + (sqlite-prepare db "\ INSERT OR IGNORE INTO Directories(name, package) -- to avoid spurious writ= es VALUES (:name, :package);" =2D #:cache? #t)) + #:cache? #t)) =20 =2D (define stmt-insert-file =2D (sqlite-prepare db "\ + (define stmt-insert-file + (sqlite-prepare db "\ INSERT OR IGNORE INTO Files(name, basename, directory) VALUES (:name, :basename, :directory);" =2D #:cache? #t)) =2D =2D (sqlite-exec db "begin immediate;") =2D (sqlite-bind-arguments stmt-insert-package =2D #:name package =2D #:version version) =2D (sqlite-fold (const #t) #t stmt-insert-package) =2D =2D (sqlite-bind-arguments stmt-select-package =2D #:name package =2D #:version version) =2D (match (sqlite-fold cons '() stmt-select-package) =2D ((#(package-id)) =2D (when debug =2D (format #t "(pkg, version, pkg-id): (~a, ~a, ~a)" =2D package version package-id)) =2D (pk 'package package-id package) =2D (for-each (lambda (directory) =2D (define (strip file) =2D (string-drop file (+ (string-length directory) 1))) =2D =2D (sqlite-reset stmt-insert-directory) =2D (sqlite-bind-arguments stmt-insert-directory =2D #:name directory =2D #:package package-id) =2D (sqlite-fold (const #t) #t stmt-insert-directory) =2D =2D (sqlite-reset stmt-select-directory) =2D (sqlite-bind-arguments stmt-select-directory =2D #:name directory =2D #:package package-id) =2D (match (sqlite-fold cons '() stmt-select-directory) =2D ((#(directory-id)) =2D (when debug =2D (format #t "(name, package, dir-id): (~a, ~a, ~a)\= n" =2D directory package-id directory-id)) =2D (for-each (lambda (file) =2D ;; If DIRECTORY is a symlink, (find-files =2D ;; DIRECTORY) returns the DIRECTORY sing= leton. =2D (unless (string=3D? file directory) =2D (sqlite-reset stmt-insert-file) =2D (sqlite-bind-arguments stmt-insert-file =2D #:name (strip f= ile) =2D #:basename =2D (basename file) =2D #:directory =2D directory-id) =2D (sqlite-fold (const #t) #t stmt-insert= -file))) =2D (find-files directory))))) =2D directories))) =2D (sqlite-exec db "commit;")) + #: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 sing= leton. + (unless (string=3D? file directory) + (sqlite-reset stmt-insert-file) + (sqlite-bind-arguments stmt-insert-file + #:name (strip f= ile) + #:basename + (basename file) + #:directory + directory-id) + (sqlite-fold (const #t) #t stmt-insert= -file))) + (find-files directory))))) + directories))) + (sqlite-exec db "commit;")) =20 ;;; @@ -212,6 +241,8 @@ (define (index-manifests db-file) (unless (file-exists? db-dirpath) (mkdir db-dirpath))) =20 + (insert-version-with-db db-file) + (call-with-database db-file (lambda (db) (for-each (lambda (entry) @@ -258,6 +289,16 @@ (define lookup-stmt ;;; CLI ;;; =20 +(define (insert-version-with-db db-pathname) + "Insert application version into the database." + (call-with-database db-pathname + (lambda (db) + (insert-version db application-version)))) + +(define (read-db-version-with-db db-pathname) + "Insert version into the database." + (call-with-database db-pathname read-version)) + (define (matching-packages-with-db db-pathname file) "Compute list of packages referencing FILE using db at DB-PATHNAME." (call-with-database db-pathname @@ -306,7 +347,7 @@ (define-command (guix-index . args) (synopsis "Index packages to allow searching package for a given filenam= e") =20 (define (parse-db-args args) =2D "Parsing of string key=3Dvalue where we are only interested in 'val= ue'" + "Parsing of string key=3Dvalue where we are only interested in 'value'" (match (string-split args #\=3D) ((unused db-path) db-path) @@ -320,6 +361,10 @@ (define (display-help-and-exit) ((or ("-h") ("--help")) (display-help-and-exit)) ((or ("-V") ("--version")) + (with-exception-handler + (lambda (exn) 'meh) ;; noop exception + (simple-format #t "Extension db version: ~a\n" (read-db-version-wit= h-db default-db-path)) + #:unwind? #t) (show-version-and-exit "guix locate")) ((db-path-args) (let ((db-path (parse-db-args db-path-args))) =2D-=20 2.38.1 From=202ecdab01c93fc4872803c5a2d16743214512cb5d Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 11 Dec 2022 20:13:44 +0100 Subject: [PATCH 20/25] extensions-index: Fix typo in help message =2D-- guix/extensions/index.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index b89eb9e6c8..3a5015afe1 100644 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -365,7 +365,7 @@ (define (display-help-and-exit) (lambda (exn) 'meh) ;; noop exception (simple-format #t "Extension db version: ~a\n" (read-db-version-wit= h-db default-db-path)) #:unwind? #t) =2D (show-version-and-exit "guix locate")) + (show-version-and-exit "guix index")) ((db-path-args) (let ((db-path (parse-db-args db-path-args))) (if db-path =2D-=20 2.38.1 From=20a30dff0161f60288ce3b260a8429c2fd3c8b8e7c Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Thu, 15 Dec 2022 13:04:08 +0100 Subject: [PATCH 21/25] extensions-index: Allow user to choose the indexation method To do so, this: =2D reverted the old code removal to reuse the indexing packages out of the local store functions =2D rewrites the cli argument parsing logic. This allows more flexibility in indexation method (for a bit more code though) =2D-- guix/extensions/index.scm | 250 ++++++++++++++++++++++++++++++-------- guix/scripts/home.scm | 2 +- 2 files changed, 199 insertions(+), 53 deletions(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index 3a5015afe1..878daf4fb6 100644 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -19,11 +19,15 @@ (define-module (guix extensions index) #:use-module ((guix i18n) #:select (G_)) #:use-module ((guix ui) #:select (show-version-and-exit =2D show-bug-report-information)) + show-bug-report-information + with-error-handling + string->number*)) + #:use-module ((guix status) #:select (with-status-verbosity)) #: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) @@ -39,10 +43,11 @@ (define-module (guix extensions index) #: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)) =20 =2D(define debug #f) +(define debug #t) =20 (define application-version 1) =20 @@ -190,6 +195,34 @@ (define (strip file) directories))) (sqlite-exec db "commit;")) =20 + +;;; +;;; 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* (index-packages-from-store db) + "Insert all current packages from the local store into the 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))))))) + ;;; ;;; Indexing from local profiles. @@ -235,14 +268,8 @@ (define (insert-manifest-entry db entry) (manifest-entry-version entry) (list (manifest-entry-item entry)))) ;FIXME: outputs? =20 =2D(define (index-manifests db-file) =2D "Insert packages entries into DB-FILE from the system manifests." =2D (let ((db-dirpath (dirname db-file))) =2D (unless (file-exists? db-dirpath) =2D (mkdir db-dirpath))) =2D =2D (insert-version-with-db db-file) =2D +(define (index-packages-from-manifests-with-db db-file) + "Index packages entries into DB-FILE from the system manifests." (call-with-database db-file (lambda (db) (for-each (lambda (entry) @@ -289,6 +316,12 @@ (define lookup-stmt ;;; CLI ;;; =20 +(define (index-packages-from-store-with-db db-pathname) + "Index packages using db at location DB-PATHNAME." + (call-with-database db-pathname + (lambda (db) + (index-packages-from-store db)))) + (define (insert-version-with-db db-pathname) "Insert application version into the database." (call-with-database db-pathname @@ -320,67 +353,180 @@ (define default-db-path =20 (define (show-help) (display (G_ "Usage: guix index [OPTIONS...] [search FILE...] =2DWithout argument, indexes (package, file) relationships in the local sto= re. +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 but this +indexes less packages. That'd be typically the use case for user local +indexation. + +- out of the local store. This is slower due to implementation details (it +discusses with the store daemon for one). That'd be typically the use case= for +building the largest db in one of the build farm node. + With 'search FILE', search for packages installing FILE.\n =2DNote: The internal cache is located at ~/.cache/guix/index/db.sqlite. +Note: Internal cache is located at ~/.cache/guix/index/db.sqlite by defaul= t. See --db-path for customization.\n")) (newline) (display (G_ "The valid values for OPTIONS are:")) (newline) (display (G_ " =2D -h, --help Display this help and exit")) + -h, --help Display this help and exit")) (display (G_ " =2D -V, --version Display version information and exit")) + -V, --version Display version information and exit")) (display (G_ " =2D --db-path=3DDIR Change default location of the cache db")) + --db-path=3DDIR Change default location of the cache db")) (newline) + (display (G_ " + --with-method=3DMETH Change default indexation method. By default it us= es the + local \"manifests\" (faster). It can also uses the l= ocal + \"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_ " + Without any argument, it index packages. This fills in t= he + db cache using whatever indexation method is defined.")) (show-bug-report-information)) =20 +(define (verbosity-level opts) + "Return the verbosity level based on OPTS, the alist of parsed options." + (or (assoc-ref opts 'verbosity) + (if (eq? (assoc-ref opts 'action) 'build) + 3 1))) + +(define %options + (list + (option '(#\h "help") #f #f + (lambda args (show-help) (exit 0))) + (option '(#\V "version") #f #f + (lambda args (show-version-and-exit "guix index"))) + (option '(#\v "verbosity") #f #t + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) + ;; 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: --with-method: opt ~a\n" opt) + (format #t "%options: --with-method: name ~a\n" name) + (format #t "%options: --with-method: arg ~a\n" arg) + (format #t "%options: --with-method: 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 "with-method") #f #t + (lambda (opt name arg result) + (when debug + (format #t "%options: --with-method: opt ~a\n" opt) + (format #t "%options: --with-method: name ~a\n" name) + (format #t "%options: --with-method: arg ~a\n" arg) + (format #t "%options: --with-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) + (verbosity . #f) + (with-method . "manifests"))) + (define-command (guix-index . args) (category extension) =2D (synopsis "Index packages to allow searching package for a given filen= ame") =2D =2D (define (parse-db-args args) =2D "Parsing of string key=3Dvalue where we are only interested in 'valu= e'" =2D (match (string-split args #\=3D) =2D ((unused db-path) =2D db-path) + (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" (as= soc-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))) =20 =2D (define (display-help-and-exit) =2D (show-help) =2D (exit 0)) =2D =2D (match args =2D ((or ("-h") ("--help")) =2D (display-help-and-exit)) =2D ((or ("-V") ("--version")) =2D (with-exception-handler =2D (lambda (exn) 'meh) ;; noop exception =2D (simple-format #t "Extension db version: ~a\n" (read-db-version-w= ith-db default-db-path)) =2D #:unwind? #t) =2D (show-version-and-exit "guix index")) =2D ((db-path-args) =2D (let ((db-path (parse-db-args db-path-args))) =2D (if db-path =2D (index-manifests db-path) =2D (display-help-and-exit)))) =2D (("search" file) =2D (let ((matches (matching-packages-with-db default-db-path file))) =2D (print-matching-results matches) =2D (exit (pair? matches)))) =2D ((db-path-args "search" file) =2D (let ((db-path (parse-db-args db-path-args))) =2D (if db-path =2D (let ((matches (matching-packages-with-db db-path file))) + (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))) + (with-status-verbosity (verbosity-level opts) + (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 ye= t. +You need to index packages first.\nTry 'guix index --help' for more inform= ation.~%")) + (exit 1)) + (let* ((file (assoc-ref args 'argument)) + (matches (matching-packages-with-db db-path file))) (print-matching-results matches) =2D (exit (pair? matches))) =2D (display-help-and-exit)))) =2D (_ ;; By default, index =2D (index-manifests default-db-path)))) + (exit (pair? matches)))) + ('index + (let ((db-dirpath (dirname db-path))) + (unless (file-exists? db-dirpath) + (mkdir db-dirpath))) + ;; FIXME: Deal with check on version and destruction/migration = if need be + (insert-version-with-db db-path) + (if (string=3D 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 1c481ccf91..bdc903f393 100644 =2D-- 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) =2D #: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)) =2D-=20 2.38.1 From=20295e4f85b6a967cd714712fe67bcaaef6bb5c29d Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Thu, 15 Dec 2022 16:34:06 +0100 Subject: [PATCH 22/25] extensions-index: Deal with db schema migrations The schema db version is dealt with. It's transparent for users. As we modi= fy along the schema for evolution, we should also provide the intermediary migration sql script so the existing db can be migrated along without losing data. =2D-- guix/extensions/index.scm | 153 ++++++++++++++++++++++---------------- 1 file changed, 90 insertions(+), 63 deletions(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index 878daf4fb6..0fd361a485 100644 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -22,7 +22,6 @@ (define-module (guix extensions index) show-bug-report-information with-error-handling string->number*)) =2D #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix scripts) #:use-module (sqlite3) #:use-module (ice-9 match) @@ -49,12 +48,18 @@ (define-module (guix extensions index) =20 (define debug #t) =20 =2D(define application-version 1) +(define application-version 2) =20 =2D(define schema +;; The following schema is the full schema at the `application-version`. = It +;; should be modified according to the development required. If the schema +;; needs modification across time, those should be changed directly in the +;; full-schema and the incremental changes should be referenced below +;; as migration step (for the existing dbs) below. +(define schema-full " create table if not exists SchemaVersion ( version integer primary key not null, + date date, unique (version) ); =20 @@ -83,22 +88,32 @@ (define schema =20 create index if not exists IndexFiles on Files(basename);") =20 +;; List of tuple ((version . sqlite schema migration script)). There shou= ld +;; be as much version increments with each 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) =2D (lambda () =2D (sqlite-exec db schema) =2D (proc db)) =2D (lambda () =2D (sqlite-close db))))) + (lambda () (proc db)) + (lambda () (sqlite-close db))))) =20 (define (insert-version db version) "Insert application VERSION into the DB." (define stmt-insert-version (sqlite-prepare db "\ =2DINSERT OR IGNORE INTO SchemaVersion(version) =2DVALUES (:version);" +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) @@ -109,8 +124,8 @@ (define (read-version db) "Read the current application version from the DB." =20 (define stmt-select-version (sqlite-prepare db "\ =2DSELECT version FROM SchemaVersion;" =2D #:cache? #t)) +SELECT version FROM SchemaVersion ORDER BY version DESC LIMIT 1;" + #:cache? #f)) (match (sqlite-fold cons '() stmt-select-version) ((#(version)) version))) @@ -268,9 +283,9 @@ (define (insert-manifest-entry db entry) (manifest-entry-version entry) (list (manifest-entry-item entry)))) ;FIXME: outputs? =20 =2D(define (index-packages-from-manifests-with-db db-file) =2D "Index packages entries into DB-FILE from the system manifests." =2D (call-with-database db-file +(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) (for-each (lambda (entry) (insert-manifest-entry db entry)) @@ -322,21 +337,40 @@ (define (index-packages-from-store-with-db db-pathnam= e) (lambda (db) (index-packages-from-store db)))) =20 =2D(define (insert-version-with-db db-pathname) =2D "Insert application version into the database." +(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) =2D (insert-version db application-version)))) + (matching-packages db file)))) =20 =2D(define (read-db-version-with-db db-pathname) =2D "Insert version into the database." =2D (call-with-database db-pathname read-version)) +(define (read-version-from-db db-pathname) + (call-with-database db-pathname + (lambda (db) (read-version db)))) =20 =2D(define (matching-packages-with-db db-pathname file) =2D "Compute list of packages referencing FILE using db at DB-PATHNAME." +(define (migrate-schema-to-version db-pathname) (call-with-database db-pathname (lambda (db) =2D (matching-packages db file)))) + (catch #t + (lambda () + ;; Migrate from the current version to the full migrated schema + ;; This can raise sqlite-error if the db is not properly configu= red 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 app= lication + (let ((schema-migration-at-version (assoc-ref schema-to-migr= ate 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)))))) =20 (define (print-matching-results matches) "Print the MATCHES matching results." @@ -392,23 +426,17 @@ (define (show-help) db cache using whatever indexation method is defined.")) (show-bug-report-information)) =20 =2D(define (verbosity-level opts) =2D "Return the verbosity level based on OPTS, the alist of parsed options= ." =2D (or (assoc-ref opts 'verbosity) =2D (if (eq? (assoc-ref opts 'action) 'build) =2D 3 1))) =2D (define %options (list (option '(#\h "help") #f #f (lambda args (show-help) (exit 0))) (option '(#\V "version") #f #f =2D (lambda args (show-version-and-exit "guix index"))) =2D (option '(#\v "verbosity") #f #t (lambda (opt name arg result) =2D (let ((level (string->number* arg))) =2D (alist-cons 'verbosity level =2D (alist-delete 'verbosity result))))) + (catch 'sqlite-error + (lambda () + (simple-format #t "Extension db version: ~a\n" (read-vers= ion-from-db (assoc-ref result '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) @@ -438,7 +466,6 @@ (define %options =20 (define %default-options `((db-path . ,default-db-path) =2D (verbosity . #f) (with-method . "manifests"))) =20 (define-command (guix-index . args) @@ -502,31 +529,31 @@ (define (fail) (action (assoc-ref args 'action)) (db-path (assoc-ref args 'db-path)) (with-method (assoc-ref args 'with-method))) =2D (with-status-verbosity (verbosity-level opts) =2D (when debug =2D (format #t "main: opts: ~a\n" opts) =2D (format #t "main: args: ~a\n" args) =2D (format #t "main: action: ~a\n" action) =2D (format #t "main: db-path: ~a\n" db-path) =2D (format #t "main: with-method: ~a\n" with-method)) =2D =2D (match action =2D ('search =2D (unless (file-exists? db-path) =2D (format (current-error-port) =2D (G_ "guix index: The local cache db does not exist = yet. + (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 inform= ation.~%")) =2D (exit 1)) =2D (let* ((file (assoc-ref args 'argument)) =2D (matches (matching-packages-with-db db-path file))) =2D (print-matching-results matches) =2D (exit (pair? matches)))) =2D ('index =2D (let ((db-dirpath (dirname db-path))) =2D (unless (file-exists? db-dirpath) =2D (mkdir db-dirpath))) =2D ;; FIXME: Deal with check on version and destruction/migratio= n if need be =2D (insert-version-with-db db-path) =2D (if (string=3D with-method "manifests") =2D (index-packages-from-manifests-with-db db-path) =2D (index-packages-from-store-with-db db-path)))))))) + (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=3D with-method "manifests") + (index-packages-from-manifests-with-db db-path) + (index-packages-from-store-with-db db-path))))))) =2D-=20 2.38.1 From=2060b2d6e1e6c9ce286844354298a3c9f2fed0adff Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Thu, 15 Dec 2022 17:21:15 +0100 Subject: [PATCH 23/25] extensions-index: Deactivate debug =2D-- guix/extensions/index.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index 0fd361a485..56841a4666 100644 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -46,7 +46,7 @@ (define-module (guix extensions index) #:use-module (srfi srfi-71) #:export (guix-index)) =20 =2D(define debug #t) +(define debug #f) =20 (define application-version 2) =20 =2D-=20 2.38.1 From=20b7485e7302862ef3e96279eca9df6f4c63bfb94c Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Thu, 15 Dec 2022 17:22:39 +0100 Subject: [PATCH 24/25] extensions-index: Expose db information in guix index -V output =2D-- guix/extensions/index.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index 56841a4666..256a43d7fd 100644 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -434,7 +434,12 @@ (define %options (lambda (opt name arg result) (catch 'sqlite-error (lambda () =2D (simple-format #t "Extension db version: ~a\n" (read-ve= rsion-from-db (assoc-ref result 'db-path)))) + (let ((db-path (assoc-ref result 'db-path))) + (simple-format + #t + "Extension local cache database:\n- path: ~a\n- versio= n: ~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) =2D-=20 2.38.1 From=2093bb890ac2f887f338a9e2fa06e6d605bfc6722c Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Thu, 15 Dec 2022 17:22:53 +0100 Subject: [PATCH 25/25] extensions-index: Wrap index computations with progr= ess bar output =2D-- guix/extensions/index.scm | 48 +++++++++++++++++++++++++++------------ 1 file changed, 33 insertions(+), 15 deletions(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index 256a43d7fd..12237f82ba 100644 =2D-- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -36,6 +36,8 @@ (define-module (guix extensions index) #: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) @@ -173,8 +175,8 @@ (define stmt-insert-file ((#(package-id)) (when debug (format #t "(pkg, version, pkg-id): (~a, ~a, ~a)" =2D package version package-id)) =2D (pk 'package package-id package) + package version package-id) + (pk 'package package-id package)) (for-each (lambda (directory) (define (strip file) (string-drop file (+ (string-length directory) 1))) @@ -229,14 +231,24 @@ (define* (index-packages-from-store db) "Insert all current packages from the local store into the DB." (with-store store (parameterize ((%graft? #f)) =2D (fold-packages (lambda (package _) =2D (run-with-store store =2D (insert-package db package))) =2D #t =2D #:select? (lambda (package) =2D (and (not (hidden-package? package)) =2D (not (package-superseded package)) =2D (supported-package? package))))))) + (let* ((packages (fold-packages + (lambda (package result) + (cons package result)) + '() + #:select? (lambda (package) + (and (not (hidden-package? package)) + (not (package-superseded packag= e)) + (supported-package? package))))) + (nb-entries (length packages)) + (prefix (format #f "Registering ~a packages" nb-entries)) + (progress (progress-reporter/bar nb-entries prefix))) + (call-with-progress-reporter progress + (lambda (report) + (for-each (lambda (package) + (run-with-store store + (insert-package db package)) + (report)) + packages))))))) =20 ;;; @@ -287,11 +299,17 @@ (define (index-packages-from-manifests-with-db db-pat= hname) "Index packages entries into DB-PATHNAME from the system manifests." (call-with-database db-pathname (lambda (db) =2D (for-each (lambda (entry) =2D (insert-manifest-entry db entry)) =2D (let ((lst (profiles->manifest-entries (all-profiles)))) =2D (pk 'entries (length lst)) =2D lst))))) + (let* ((profiles (all-profiles)) + (entries (profiles->manifest-entries profiles)) + (nb-entries (length entries)) + (prefix (format #f "Registering ~a packages" nb-entries)) + (progress (progress-reporter/bar nb-entries prefix))) + (call-with-progress-reporter progress + (lambda (report) + (for-each (lambda (entry) + (insert-manifest-entry db entry) + (report)) + entries))))))) =20 ;;; =2D-=20 2.38.1 --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ludovic Court=C3=A8s writes: > Hi! > > "Antoine R. Dumont (@ardumont)" skribis: > >> |-----------+-------------+----------+----------| >> | Iteration | Host System | Time (s) | Packages | >> |-----------+-------------+----------+----------| >> | 1st | Debian | 121.88 | 284 | >> | | Guix System | 413.55 | 749 | >> |-----------+-------------+----------+----------| >> | 2nd | Debian | 1.3 | 101 | >> | | Guix System | 11.54 | 354 | >> |-----------+-------------+----------+----------| > > Ah, that=E2=80=99s a significant difference. > > I guess we can keep both methods: the exhaustive one that goes over all > packages, and the quick one. Then we can have a switch to select the > method. > > Typically, we may want to use the expensive one on the build farm to > publish a full database, while on user=E2=80=99s machines we may want to = default > to the cheaper one. > >>> Oh, and progress bars too. >> >> I'm a bit unsettled on this. Hopefully it was mostly a joke ;) > > It wasn=E2=80=99t. :-) > > In the manifest case, we get =E2=80=98all-profiles=E2=80=99 is almost ins= tantaneous, so > we immediately known the number of manifests we=E2=80=99ll be working on. > > In the package case, the number of packages is known ahead. > > The (guix progress) module provides helpers. > > But anyway, that=E2=80=99s more like icing on the cake, we can leave that= for > later. > > Thanks, > Ludo=E2=80=99. --=-=-=-- --==-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJUBAEBCgA+FiEEvwAgPXQaydVGqL4HUuLphA0Qw7gFAmObU0UgHGFudG9pbmUu cm9tYWluLmR1bW9udEBnbWFpbC5jb20ACgkQUuLphA0Qw7hSbRAAsqxtE2HbemU4 7jLrAlOhYXDt1eD/7zntfa2vO069TCb6M4zTcmD0d44pVOVNsiz8cIyvTPLFNYli nsF3tBVaaOeohDcc6KDkxVVMKX4klzg9wo074c1sqDbrUq8Lno2x8Bd+zITAZKo5 U+M+1uzt8sgQ88BYXVfrwwr7a+dp3D5frJvPxU2wJZNzKC0uB+msRiA7dGswNska 0ievHJn9LRrzpIW5+/tMI26ntvSwlZQ+czHWH12jLhukPlUUkSjfsPdcxNrT8sT9 NlTyynwuRZ4F0rqMekYSQfGCJNzH3JI76KPAeM5WlO/RmLuAqtkVUdPUCT3yYNjk TzcFLXgkq9uX1cDQ112VgPA0mH7Ec93yQSc75cnYSrf0CHcat66KrmEY2p2F6mK2 L3fbCA4w+zW+l+l6C5OTuko49fy0wnF/JPbxzI8kySP27vmt/K49ZUzsqt1qJFUc wb5ggu2KYbwFWxdzkmIJY58LsvGK1Xfy34PI4I8JHav2hMxbBx6GOt2D84HgTa4j 5k1f8DvR6wUYjZSjw49NonbRPMinTfCP3PIC7ewMmYwrJ0X3iuX+Q5v71Ddbr+mL nvApq0PHgIoQvvFIEA32ptKgZy+OaiNrk52cbSDsdvAll+1/b9RVrpIcTc98IAyV Be0WORJorApGA2lSvJAF6ZmBjxREL2w= =pkJq -----END PGP SIGNATURE----- --==-=-=--