Toggle diff (382 lines)
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index d5bc5fb46e..6a3b9c83d4 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; This file is part of GNU Guix.
@@ -241,7 +241,7 @@ interface (FFI) of Guile.")
(define* (build-program source version
#:optional (guile-version (effective-version))
- #:key (pull-version 0))
+ #:key (pull-version 0) (channel-metadata #f))
"Return a program that computes the derivation to build Guix from SOURCE."
;; Select every module but (guix config) and non-Guix modules.
@@ -359,6 +359,8 @@ interface (FFI) of Guile.")
(guix-derivation source version
@@ -380,7 +382,9 @@ interface (FFI) of Guile.")
;; The procedure below is our return value.
- #:key verbose? (version (date-version-string)) system
+ (version (date-version-string)) channel-metadata
;; For the standalone Guix, default to Guile 3.0. For old
@@ -397,6 +401,7 @@ files."
;; Build the build program and then use it as a trampoline to build from
(mlet %store-monad ((build (build-program source version guile-version
+ #:channel-metadata channel-metadata
#:pull-version pull-version))
(system (if system (return system) (current-system)))
(home -> (getenv "HOME"))
diff --git a/guix/channels.scm b/guix/channels.scm
index e7e1eb6fd0..3cc3b4c438 100644
@@ -626,16 +626,23 @@ that unconditionally resumes the continuation."
(values (run-with-store store mvalue)
-(define* (build-from-source name source
- #:key core verbose? commit
- "Return a derivation to build Guix from SOURCE, using the self-build script
-contained therein; use COMMIT as the version string. When CORE is true, build
-package modules under SOURCE using CORE, an instance of Guix."
+(define* (build-from-source instance
+ #:key core verbose? (dependencies '()))
+ "Return a derivation to build Guix from INSTANCE, using the self-build
+script contained therein. When CORE is true, build package modules under
+SOURCE using CORE, an instance of Guix."
+ (channel-name (channel-instance-channel instance))))
+ (channel-instance-checkout instance))
+ (channel-instance-commit instance))
;; Running the self-build script makes it easier to update the build
;; procedure: the self-build script of the Guix-to-be-installed contains the
;; right dependencies, build procedure, etc., which the Guix-in-use may not
(string-append source "/" %self-build-file))
@@ -661,7 +668,9 @@ package modules under SOURCE using CORE, an instance of Guix."
;; cause us to redo half of the BUILD computation several times just
;; to realize it gives the same result.
(with-trivial-build-handler
- (build source #:verbose? verbose? #:version commit
+ #:verbose? verbose? #:version commit
+ #:channel-metadata (channel-instance->sexp instance)
#:pull-version %pull-version))))
;; Build a set of modules that extend Guix using the standard method.
@@ -672,10 +681,7 @@ package modules under SOURCE using CORE, an instance of Guix."
"Return, as a monadic value, the derivation for INSTANCE, a channel
instance. DEPENDENCIES is a list of extensions providing Guile modules that
- (build-from-source (symbol->string
- (channel-name (channel-instance-channel instance)))
- (channel-instance-checkout instance)
- #:commit (channel-instance-commit instance)
+ (build-from-source instance
#:dependencies dependencies))
diff --git a/guix/config.scm.in b/guix/config.scm.in
index b2901735d8..223c9eb418 100644
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Caleb Ristvedt <caleb.ristvedt@cune.org>
;;; This file is part of GNU Guix.
(define %guix-home-page-url
+(define %channel-metadata
+ ;; When true, this is an sexp containing metadata for the 'guix' channel
+ ;; this file was built from. This is used by (guix describe).
+ ;; TODO: Implement 'configure.ac' machinery to initialize it.
diff --git a/guix/describe.scm b/guix/describe.scm
index ac89fc0d7c..6a31c707f0 100644
#:use-module ((guix utils) #:select (location-file))
#:use-module ((guix store) #:select (%store-prefix store-path?))
#:use-module ((guix config) #:select (%state-directory))
- #:autoload (guix channels) (sexp->channel)
+ #:autoload (guix channels) (sexp->channel manifest-entry-channel)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (current-profile
@@ -87,10 +88,19 @@ as a number of seconds since the Epoch, or #f if it could not be determined."
(string-append (dirname file) "/" target)))))
+(define (channel-metadata)
+ "Return the 'guix' channel metadata sexp from (guix config) if available;
+ ;; Older 'build-self.scm' would create a (guix config) file without the
+ ;; '%channel-metadata' variable. Thus, properly deal with a lack of
+ (let ((module (resolve-interface '(guix config))))
+ (and=> (module-variable module '%channel-metadata) variable-ref)))
(define current-profile-entries
"Return the list of entries in the 'guix pull' profile the calling process
-lives in, or #f if this is not applicable."
+lives in, or the empty list if this is not applicable."
@@ -105,6 +115,20 @@ lives in, or #f if this is not applicable."
(string=? (manifest-entry-name entry) "guix"))
(current-profile-entries))))
+(define current-channels
+ "Return the list of channels currently available, including the 'guix'
+channel. Return the empty list if this information is missing."
+ (match (current-profile-entries)
+ ;; As a fallback, if we're not running from a profile, use 'guix'
+ ;; channel metadata from (guix config).
+ (match (channel-metadata)
+ (sexp (or (and=> (sexp->channel sexp 'guix) list) '()))))
+ (filter-map manifest-entry-channel entries)))))
(define (package-path-entries)
"Return two values: the list of package path entries to be added to the
package search path, and the list to be added to %LOAD-COMPILED-PATH. These
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index e47d207ee0..cd5d3838a8 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -182,20 +182,18 @@ string is ~a.~%")
(display-package-search-path fmt)))
-(define (display-profile-info profile fmt)
+(define* (display-profile-info profile fmt
+ (channels (profile-channels profile)))
"Display information about PROFILE, a profile as created by (guix channels),
-in the format specified by FMT."
+in the format specified by FMT. PROFILE can be #f, in which case CHANNELS is
- (generation-number profile))
- (profile-channels (if (zero? number)
- (generation-file-name profile number))))
+ (and profile (generation-number profile)))
- (display-profile-content profile number))
+ (display-profile-content profile number channels))
(pretty-print `(list ,@(map channel->code channels))))
@@ -213,33 +211,29 @@ in the format specified by FMT."
(display-package-search-path fmt))
-(define (display-profile-content profile number)
- "Display the packages in PROFILE, generation NUMBER, in a human-readable
-way and displaying details about the channel's source code."
- (display-generation profile number)
- (for-each (lambda (entry)
+(define* (display-profile-content profile number
+ (channels (profile-channels profile)))
+ "Display CHANNELS along with PROFILE info, generation NUMBER, in a
+human-readable way and displaying details about the channel's source code.
+ (when (and number profile)
+ (display-generation profile number))
+ (for-each (lambda (channel)
- (manifest-entry-name entry)
- (manifest-entry-version entry))
- (match (manifest-entry-channel entry)
- (format #t (G_ " repository URL: ~a~%")
- (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))))
- ;; Show most recently installed packages last.
- (profile-manifest (if (zero? number)
- (generation-file-name profile number)))))))
+ (string-take (channel-commit channel) 7))
+ (format #t (G_ " repository URL: ~a~%")
+ (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))))
;; Hard-coded list of host names and corresponding web view URL templates.
@@ -295,6 +289,10 @@ text. The hyperlink links to a web view of COMMIT, when available."
- (display-checkout-info format))
+ (match (current-channels)
+ (display-checkout-info format))
+ (display-profile-info #f format channels))))
(display-profile-info (canonicalize-profile profile) format))))))
diff --git a/guix/self.scm b/guix/self.scm
index 15c8ad4eb9..35fba1152d 100644
@@ -793,7 +793,9 @@ itself."
(((labels packages _ ...) ...)
(cons package packages))))
-(define* (compiled-guix source #:key (version %guix-version)
+(define* (compiled-guix source #:key
+ (version %guix-version)
(name (string-append "guix-" version))
(guile-version (effective-version))
@@ -977,6 +979,8 @@ itself."
@@ -1070,6 +1074,7 @@ itself."
(define* (make-config.scm #:key gzip xz bzip2
(package-name "GNU Guix")
(bug-report-address "bug-guix@gnu.org")
(home-page-url "https://guix.gnu.org"))
@@ -1083,6 +1088,7 @@ itself."
@@ -1125,6 +1131,11 @@ itself."
(define %guix-bug-report-address #$bug-report-address)
(define %guix-home-page-url #$home-page-url)
+ (define %channel-metadata
+ ;; Metadata for the 'guix' channel in use. This
+ ;; information is used by (guix describe).
#+(and gzip (file-append gzip "/bin/gzip")))
@@ -1249,11 +1260,14 @@ containing MODULE-FILES and possibly other files as well."
(define* (guix-derivation source version
#:optional (guile-version (effective-version))
- #:key (pull-version 0))
"Return, as a monadic value, the derivation to build the Guix from SOURCE
-for GUILE-VERSION. Use VERSION as the version string. PULL-VERSION specifies
-the version of the 'guix pull' protocol. Return #f if this PULL-VERSION value
+for GUILE-VERSION. Use VERSION as the version string. Use CHANNEL-METADATA
+as the channel metadata sexp to include in (guix config).
+PULL-VERSION specifies the version of the 'guix pull' protocol. Return #f if
+this PULL-VERSION value is not supported."
(define (shorten version)
(if (and (string-every char-set:hex-digit version)
(> (string-length version) 9))
@@ -1278,6 +1292,7 @@ is not supported."
(set-guile-for-build guile)
(let ((guix (compiled-guix source
+ #:channel-metadata channel-metadata
#:name (string-append "guix-"
#:pull-version pull-version