From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:42810) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ibBIX-0006Pv-0T for guix-patches@gnu.org; Sat, 30 Nov 2019 17:33:06 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ibBIV-0004S5-Q2 for guix-patches@gnu.org; Sat, 30 Nov 2019 17:33:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:57557) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ibBIV-0004Rz-LM for guix-patches@gnu.org; Sat, 30 Nov 2019 17:33:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ibBIV-0006lU-JM for guix-patches@gnu.org; Sat, 30 Nov 2019 17:33:03 -0500 Subject: [bug#38441] [PATCH 4/5] guix system: "list-generations" displays provenance info. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Sat, 30 Nov 2019 23:31:47 +0100 Message-Id: <20191130223148.14336-4-ludo@gnu.org> In-Reply-To: <20191130223148.14336-1-ludo@gnu.org> References: <20191130223148.14336-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit 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: 38441@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= * guix/scripts/pull.scm (channel-commit-hyperlink): Export. * guix/scripts/system.scm (display-system-generation) [display-channel]: New procedure. Read the "provenance" file of GENERATION and display channel info and the configuration file name when available. --- guix/scripts/pull.scm | 1 + guix/scripts/system.scm | 49 +++++++++++++++++++++++++++++++++++++++-- 2 files changed, 48 insertions(+), 2 deletions(-) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 19410ad141..04cc51829d 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -60,6 +60,7 @@ #:use-module (ice-9 format) #:export (display-profile-content channel-list + channel-commit-hyperlink with-git-error-handling guix-pull)) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index b22945658e..0ddb40a03c 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -36,9 +36,11 @@ #:use-module (guix records) #:use-module (guix profiles) #:use-module (guix scripts) + #:use-module (guix channels) #:use-module (guix scripts build) #:autoload (guix scripts package) (delete-generations delete-matching-generations) + #:autoload (guix scripts pull) (channel-commit-hyperlink) #:use-module (guix graph) #:use-module (guix scripts graph) #:use-module (guix scripts system reconfigure) @@ -456,9 +458,30 @@ list of services." ;;; Generations. ;;; +(define (sexp->channel sexp) + "Return the channel corresponding to SEXP, an sexp as found in the +\"provenance\" file produced by 'provenance-service-type'." + (match sexp + (('channel ('name name) + ('url url) + ('branch branch) + ('commit commit)) + (channel (name name) (url url) + (branch branch) (commit commit))))) + (define* (display-system-generation number #:optional (profile %system-profile)) "Display a summary of system generation NUMBER in a human-readable format." + (define (display-channel channel) + (format #t " ~a:~%" (channel-name channel)) + (format #t (G_ " repository URL: ~a~%") (channel-url channel)) + (when (channel-branch channel) + (format #t (G_ " branch: ~a~%") (channel-branch channel))) + (format #t (G_ " commit: ~a~%") + (if (supports-hyperlinks?) + (channel-commit-hyperlink channel) + (channel-commit channel)))) + (unless (zero? number) (let* ((generation (generation-file-name profile number)) (params (read-boot-parameters-file generation)) @@ -468,7 +491,13 @@ list of services." (root-device (if (bytevector? root) (uuid->string root) root)) - (kernel (boot-parameters-kernel params))) + (kernel (boot-parameters-kernel params)) + (provenance (catch 'system-error + (lambda () + (call-with-input-file + (string-append generation "/provenance") + read)) + (const #f)))) (display-generation profile number) (format #t (G_ " file name: ~a~%") generation) (format #t (G_ " canonical file name: ~a~%") (readlink* generation)) @@ -495,7 +524,23 @@ list of services." (else root-device))) - (format #t (G_ " kernel: ~a~%") kernel)))) + (format #t (G_ " kernel: ~a~%") kernel) + + (match provenance + (#f #t) + (('provenance ('version 0) + ('channels channels ...) + ('configuration-file config-file)) + (unless (null? channels) + ;; TRANSLATORS: Here "channel" is the same terminology as used in + ;; "guix describe" and "guix pull --channels". + (format #t (G_ " channels:~%")) + (for-each display-channel (map sexp->channel channels))) + (when config-file + (format #t (G_ " configuration file: ~a~%") + (if (supports-hyperlinks?) + (file-hyperlink config-file) + config-file)))))))) (define* (list-generations pattern #:optional (profile %system-profile)) "Display in a human-readable format all the system generations matching -- 2.24.0