me
/
guix
Archived
1
0
Fork 0
Code

channels: Record 'guix' channel metadata in (guix config). 

Partially fixes <https://bugs.gnu.org/45896>.

* guix/config.scm.in (%channel-metadata): New variable.
* guix/describe.scm (channel-metadata): Use it.
(current-channels): New procedure.
(current-profile-entries): Clarify docstring.
* guix/self.scm (compiled-guix): Add #:channel-metadata and pass it to
'make-config.scm'.
(make-config.scm): Add #:channel-metadata and define '%channel-metadata'
in the generated file.
(guix-derivation): Add #:channel-metadata and pass it to 'compiled-guix'.
* guix/channels.scm (build-from-source): Replace 'name', 'source', and
'commit' parameters with 'instance'.  Pass #:channel-metadata to BUILD.
(build-channel-instance): Adjust accordingly.
* build-aux/build-self.scm (build-program): Add #:channel-metadata
and pass it to 'guix-derivation'.
(build): Add #:channel-metadata and pass it to 'build-program'.
* guix/scripts/describe.scm (display-profile-info): Add optional
'channels' parameter.  Pass it to 'display-profile-content'.
(display-profile-content): Add optional 'channels' parameter and honor
it.  Iterate on CHANNELS rather than on the manifest entries of
PROFILE.
(guix-describe): When PROFILE is #f, call 'current-channels' and pass it
to 'display-profile-info', unless it returns the empty list.
master
Ludovic Courtès 2021-01-27 14:46:10 +01:00
parent 814ee99da8
commit 316fc2acbb
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
6 changed files with 116 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
build-aux/build-self.scm
View File

@ -1,5 +1,5 @@
;;; 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."
(define select?
;; Select every module but (guix config) and non-Guix modules.
@ -359,6 +359,8 @@ interface (FFI) of Guile.")
(run-with-store store
(guix-derivation source version
#$guile-version
#:channel-metadata
'#$channel-metadata
#:pull-version
#$pull-version)
#:system system)
@ -380,7 +382,9 @@ interface (FFI) of Guile.")
;; The procedure below is our return value.
(define* (build source
#:key verbose? (version (date-version-string)) system
#:key verbose?
(version (date-version-string)) channel-metadata
system
(pull-version 0)
;; 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
;; SOURCE.
(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"))

30
guix/channels.scm
View File

@ -626,16 +626,23 @@ that unconditionally resumes the continuation."
(values (run-with-store store mvalue)
store))))
(define* (build-from-source name source
#:key core verbose? commit
(dependencies '()))
"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."
(define name
(symbol->string
(channel-name (channel-instance-channel instance))))
(define source
(channel-instance-checkout instance))
(define commit
(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
;; be know.
;; know.
(define script
(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
(build source
#: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
INSTANCE depends on."
(build-from-source (symbol->string
(channel-name (channel-instance-channel instance)))
(channel-instance-checkout instance)
#:commit (channel-instance-commit instance)
(build-from-source instance
#:core core
#:dependencies dependencies))

11
guix/config.scm.in
View File

@ -1,5 +1,5 @@
;;; 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.
@ -23,6 +23,8 @@
%guix-bug-report-address
%guix-home-page-url
%channel-metadata
%storedir
%localstatedir
%sysconfdir
@ -56,6 +58,13 @@
(define %guix-home-page-url
"@PACKAGE_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.
#f)
(define %storedir
"@storedir@")

28
guix/describe.scm
View File

@ -23,12 +23,13 @@
#: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
current-profile-date
current-profile-entries
current-channels
package-path-entries
package-provenance
@ -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)))))
(const #f)))))))
(define (channel-metadata)
"Return the 'guix' channel metadata sexp from (guix config) if available;
otherwise return #f."
;; Older 'build-self.scm' would create a (guix config) file without the
;; '%channel-metadata' variable. Thus, properly deal with a lack of
;; information.
(let ((module (resolve-interface '(guix config))))
(and=> (module-variable module '%channel-metadata) variable-ref)))
(define current-profile-entries
(mlambda ()
"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."
(match (current-profile)
(#f '())
(profile
@ -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
(mlambda ()
"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)
(#f '())
(sexp (or (and=> (sexp->channel sexp 'guix) list) '()))))
(entries
(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

70
guix/scripts/describe.scm
View File

@ -182,20 +182,18 @@ string is ~a.~%")
(current-output-port))))
(display-package-search-path fmt)))
(define (display-profile-info profile fmt)
(define* (display-profile-info profile fmt
#:optional
(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
what matters."
(define number
(generation-number profile))
(define channels
(profile-channels (if (zero? number)
profile
(generation-file-name profile number))))
(and profile (generation-number profile)))
(match fmt
('human
(display-profile-content profile number))
(display-profile-content profile number channels))
('channels
(pretty-print `(list ,@(map channel->code channels))))
('channels-sans-intro
@ -213,33 +211,29 @@ in the format specified by FMT."
channels))))
(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)
(format #t " ~a ~a~%"
(manifest-entry-name entry)
(manifest-entry-version entry))
(match (manifest-entry-channel entry)
((? channel? 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))))
(_ #f)))
(define* (display-profile-content profile number
#:optional
(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.
PROFILE and NUMBER "
(when (and number profile)
(display-generation profile number))
;; Show most recently installed packages last.
(reverse
(manifest-entries
(profile-manifest (if (zero? number)
profile
(generation-file-name profile number)))))))
(for-each (lambda (channel)
(format #t " ~a ~a~%"
(channel-name channel)
(string-take (channel-commit channel) 7))
(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))))
channels))
(define %vcs-web-views
;; 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."
(with-error-handling
(match profile
(#f
(display-checkout-info format))
(match (current-channels)
(()
(display-checkout-info format))
(channels
(display-profile-info #f format channels))))
(profile
(display-profile-info (canonicalize-profile profile) format))))))

25
guix/self.scm
View File

@ -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)
(channel-metadata #f)
(pull-version 1)
(name (string-append "guix-" version))
(guile-version (effective-version))
@ -977,6 +979,8 @@ itself."
%guix-package-name
#:package-version
version
#:channel-metadata
channel-metadata
#:bug-report-address
%guix-bug-report-address
#:home-page-url
@ -1070,6 +1074,7 @@ itself."
(define* (make-config.scm #:key gzip xz bzip2
(package-name "GNU Guix")
(package-version "0")
(channel-metadata #f)
(bug-report-address "bug-guix@gnu.org")
(home-page-url "https://guix.gnu.org"))
@ -1083,6 +1088,7 @@ itself."
%guix-version
%guix-bug-report-address
%guix-home-page-url
%channel-metadata
%system
%store-directory
%state-directory
@ -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).
'#$channel-metadata)
(define %gzip
#+(and gzip (file-append gzip "/bin/gzip")))
(define %bzip2
@ -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))
#:key (pull-version 0)
channel-metadata)
"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
is not supported."
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
#:version version
#:channel-metadata channel-metadata
#:name (string-append "guix-"
(shorten version))
#:pull-version pull-version