From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:41549) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fxAOM-0000Kr-2N for guix-patches@gnu.org; Tue, 04 Sep 2018 08:25:11 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fxAOG-0005n6-9J for guix-patches@gnu.org; Tue, 04 Sep 2018 08:25:10 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:40112) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fxAOG-0005mp-0v for guix-patches@gnu.org; Tue, 04 Sep 2018 08:25:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fxAOF-0003II-PF for guix-patches@gnu.org; Tue, 04 Sep 2018 08:25:03 -0400 Subject: [bug#32632] [PATCH 3/3] guix package: Record package provenance in manifest entries. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Tue, 4 Sep 2018 14:23:45 +0200 Message-Id: <20180904122345.23979-3-ludo@gnu.org> In-Reply-To: <20180904122345.23979-1-ludo@gnu.org> References: <20180904122345.23979-1-ludo@gnu.org> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 32632@debbugs.gnu.org * guix/profiles.scm (package->manifest-entry): Add #:properties and honor it. * guix/scripts/package.scm (package-provenance) (package->manifest-entry*): New procedures. (transaction-upgrade-entry, options->installable): Use 'package->manifest-entry*' instead of 'package->manifest-entry'. --- guix/profiles.scm | 6 +++-- guix/scripts/package.scm | 57 ++++++++++++++++++++++++++++++++++++---- 2 files changed, 56 insertions(+), 7 deletions(-) diff --git a/guix/profiles.scm b/guix/profiles.scm index f34f4fcff..8acfcff8c 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -286,7 +286,8 @@ file name." (manifest-transitive-entries manifest)))) (define* (package->manifest-entry package #:optional (output "out") - #:key (parent (delay #f))) + #:key (parent (delay #f)) + (properties '())) "Return a manifest entry for the OUTPUT of package PACKAGE." ;; For each dependency, keep a promise pointing to its "parent" entry. (letrec* ((deps (map (match-lambda @@ -305,7 +306,8 @@ file name." (dependencies (delete-duplicates deps)) (search-paths (package-transitive-native-search-paths package)) - (parent parent)))) + (parent parent) + (properties properties)))) entry)) (define (packages->manifest packages) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index b38a55d01..97bcc699d 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -35,6 +35,7 @@ #:use-module (guix config) #:use-module (guix scripts) #:use-module (guix scripts build) + #:autoload (guix describe) (current-profile-entries) #:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) #:use-module (ice-9 format) @@ -238,7 +239,7 @@ of relevance scores." (info (G_ "package '~a' has been superseded by '~a'~%") (manifest-entry-name old) (package-name new)) (manifest-transaction-install-entry - (package->manifest-entry new (manifest-entry-output old)) + (package->manifest-entry* new (manifest-entry-output old)) (manifest-transaction-remove-pattern (manifest-pattern (name (manifest-entry-name old)) @@ -261,7 +262,7 @@ of relevance scores." (case (version-compare candidate-version version) ((>) (manifest-transaction-install-entry - (package->manifest-entry pkg output) + (package->manifest-entry* pkg output) transaction)) ((<) transaction) @@ -274,7 +275,7 @@ of relevance scores." (null? (package-propagated-inputs pkg))) transaction (manifest-transaction-install-entry - (package->manifest-entry pkg output) + (package->manifest-entry* pkg output) transaction)))))))) (#f (warning (G_ "package '~a' no longer exists~%") name) @@ -570,6 +571,52 @@ upgrading, #f otherwise." (output "out") ;XXX: wild guess (item item)))) +(define (package-provenance package) + "Return the provenance of PACKAGE as an sexp for use as the 'provenance' +property of manifest entries, or #f if it could not be determined." + (define (entry-source entry) + (match (assq 'source + (manifest-entry-properties entry)) + (('source value) value) + (_ #f))) + + (match (and=> (package-location package) location-file) + (#f #f) + (file + (let ((file (if (string-prefix? "/" file) + file + (search-path %load-path file)))) + (and file + (string-prefix? (%store-prefix) file) + + ;; Always store information about the 'guix' channel and + ;; optionally about the specific channel FILE comes from. + (or (let ((main (and=> (find (lambda (entry) + (string=? "guix" + (manifest-entry-name entry))) + (current-profile-entries)) + entry-source)) + (extra (any (lambda (entry) + (let ((item (manifest-entry-item entry))) + (and (string-prefix? item file) + (entry-source entry)))) + (current-profile-entries)))) + (and main + `(,main + ,@(if extra (list extra) '())))))))))) + +(define (package->manifest-entry* package output) + "Like 'package->manifest-entry', but attach PACKAGE provenance meta-data to +the resulting manifest entry." + (define (provenance-properties package) + (match (package-provenance package) + (#f '()) + (sexp `((provenance ,@sexp))))) + + (package->manifest-entry package output + #:properties (provenance-properties package))) + + (define (options->installable opts manifest transaction) "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold', return an variant of TRANSACTION that accounts for the specified installations @@ -590,13 +637,13 @@ and upgrades." (('install . (? package? p)) ;; When given a package via `-e', install the first of its ;; outputs (XXX). - (package->manifest-entry p "out")) + (package->manifest-entry* p "out")) (('install . (? string? spec)) (if (store-path? spec) (store-item->manifest-entry spec) (let-values (((package output) (specification->package+output spec))) - (package->manifest-entry package output)))) + (package->manifest-entry* package output)))) (_ #f)) opts)) -- 2.18.0