guix package: Add '--export-channels'.

* guix/channels.scm (sexp->channel): Export.
* guix/describe.scm: Use (guix channels).
(manifest-entry-provenance): New procedure.
* guix/scripts/package.scm (channel=?, export-channels): New
procedures.
(show-help, %options): Add '--export-channels'.
(process-query): Honor it.
* build-aux/build-self.scm (build-program)[select?]: Exclude (guix
channels) to account for the (guix describe) change above.
* doc/guix.texi (Invoking guix package): Document it.
This commit is contained in:
Ludovic Courtès 2021-01-10 22:13:04 +01:00
parent 60d72f5364
commit aedbc5ff32
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 121 additions and 2 deletions

View file

@ -245,8 +245,11 @@ (define* (build-program source version
"Return a program that computes the derivation to build Guix from SOURCE." "Return a program that computes the derivation to build Guix from SOURCE."
(define select? (define select?
;; Select every module but (guix config) and non-Guix modules. ;; Select every module but (guix config) and non-Guix modules.
;; Also exclude (guix channels): it is autoloaded by (guix describe), but
;; only for peripheral functionality.
(match-lambda (match-lambda
(('guix 'config) #f) (('guix 'config) #f)
(('guix 'channels) #f)
(('guix _ ...) #t) (('guix _ ...) #t)
(('gnu _ ...) #t) (('gnu _ ...) #t)
(_ #f))) (_ #f)))

View file

@ -3616,7 +3616,31 @@ exactly what you specified.
Keep in mind that a manifest is purely symbolic: it only contains Keep in mind that a manifest is purely symbolic: it only contains
package names and possibly versions, and their meaning varies over time. package names and possibly versions, and their meaning varies over time.
If you wish to ``pin'' channels to the revisions that were used to build
the profile(s), see @option{--export-channels} below.
@cindex pinning, channel revisions of a profile
@item --export-channels
Write to standard output the list of channels used by the chosen
profile(s), in a format suitable for @command{guix pull --channels} or
@command{guix time-machine --channels} (@pxref{Channels}).
Together with @option{--export-manifest}, this option provides
information allowing you to replicate the current profile
(@pxref{Replicating Guix}).
However, note that the output of this command @emph{approximates} what
was actually used to build this profile. In particular, a single
profile might have been built from several different revisions of the
same channel. In that case, @option{--export-manifest} chooses the last
one and writes the list of other revisions in a comment. If you really
need to pick packages from different channel revisions, you can use
inferiors in your manifest to do so (@pxref{Inferiors}).
Together with @option{--export-manifest}, this is a good starting point
if you are willing to migrate from the ``imperative'' model to the fully
declarative model consisting of a manifest file along with a channels
file pinning the exact channel revision(s) you want.
@end table @end table
Finally, since @command{guix package} may actually start build Finally, since @command{guix package} may actually start build

View file

@ -92,6 +92,7 @@ (define-module (guix channels)
profile-channels profile-channels
manifest-entry-channel manifest-entry-channel
sexp->channel
channel->code channel->code
channel-news-entry? channel-news-entry?

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -23,6 +23,7 @@ (define-module (guix describe)
#:use-module ((guix utils) #:select (location-file)) #:use-module ((guix utils) #:select (location-file))
#:use-module ((guix store) #:select (%store-prefix store-path?)) #:use-module ((guix store) #:select (%store-prefix store-path?))
#:use-module ((guix config) #:select (%state-directory)) #:use-module ((guix config) #:select (%state-directory))
#:autoload (guix channels) (sexp->channel)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (current-profile #:export (current-profile
@ -31,7 +32,8 @@ (define-module (guix describe)
package-path-entries package-path-entries
package-provenance package-provenance
manifest-entry-with-provenance)) manifest-entry-with-provenance
manifest-entry-provenance))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -166,3 +168,31 @@ (define (manifest-entry-with-provenance entry)
(#f properties) (#f properties)
(sexp `((provenance ,@sexp) (sexp `((provenance ,@sexp)
,@properties))))))))) ,@properties)))))))))
(define (manifest-entry-provenance entry)
"Return the list of channels ENTRY comes from. Return the empty list if
that information is missing."
(match (assq-ref (manifest-entry-properties entry) 'provenance)
((main extras ...)
;; XXX: Until recently, channel sexps lacked the channel name. For
;; entries created by 'manifest-entry-with-provenance', the first sexp
;; is known to be the 'guix channel, and for the other ones, invent a
;; fallback name (it's OK as the name is just a "pet name").
(match (sexp->channel main 'guix)
(#f '())
(channel
(let loop ((extras extras)
(counter 1)
(channels (list channel)))
(match extras
(()
(reverse channels))
((head . tail)
(let* ((name (string->symbol
(format #f "channel~a" counter)))
(extra (sexp->channel head name)))
(if extra
(loop tail (+ 1 counter) (cons extra channels))
(loop tail counter channels)))))))))
(_
'())))

View file

@ -43,6 +43,7 @@ (define-module (guix scripts package)
#:use-module (guix scripts build) #:use-module (guix scripts build)
#:use-module (guix transformations) #:use-module (guix transformations)
#:use-module (guix describe) #:use-module (guix describe)
#:autoload (guix channels) (channel-name channel-commit channel->code)
#:autoload (guix store roots) (gc-roots user-owned?) #:autoload (guix store roots) (gc-roots user-owned?)
#:use-module ((guix build utils) #:use-module ((guix build utils)
#:select (directory-exists? mkdir-p)) #:select (directory-exists? mkdir-p))
@ -363,6 +364,54 @@ (define (version-spec entry)
(pretty-print exp port)) (pretty-print exp port))
exp)))) exp))))
(define (channel=? a b)
(and (channel-commit a) (channel-commit b)
(string=? (channel-commit a) (channel-commit b))))
(define* (export-channels manifest
#:optional (port (current-output-port)))
(define channels
(delete-duplicates
(append-map manifest-entry-provenance (manifest-entries manifest))
channel=?))
(define channel-names
(delete-duplicates (map channel-name channels)))
(define table
(fold (lambda (channel table)
(vhash-consq (channel-name channel) channel table))
vlist-null
channels))
(when (null? channels)
(leave (G_ "no provenance information for this profile~%")))
(format port (G_ "\
;; This channel file can be passed to 'guix pull -C' or to
;; 'guix time-machine -C' to obtain the Guix revision that was
;; used to populate this profile.\n"))
(newline port)
(display "(list\n" port)
(for-each (lambda (name)
(define indent " ")
(match (vhash-foldq* cons '() name table)
((channel extra ...)
(unless (null? extra)
(display indent port)
(format port (G_ "\
;; Note: these other commits were also used to install \
some of the packages in this profile:~%"))
(for-each (lambda (channel)
(format port "~a;; ~s~%"
indent (channel-commit channel)))
extra))
(pretty-print (channel->code channel) port
#:per-line-prefix indent))))
channel-names)
(display ")\n" port)
#t)
;;; ;;;
;;; Command-line options. ;;; Command-line options.
@ -418,6 +467,8 @@ (define (show-help)
switch to a generation matching PATTERN")) switch to a generation matching PATTERN"))
(display (G_ " (display (G_ "
--export-manifest print a manifest for the chosen profile")) --export-manifest print a manifest for the chosen profile"))
(display (G_ "
--export-channels print channels for the chosen profile"))
(display (G_ " (display (G_ "
-p, --profile=PROFILE use PROFILE instead of the user's default profile")) -p, --profile=PROFILE use PROFILE instead of the user's default profile"))
(display (G_ " (display (G_ "
@ -556,6 +607,10 @@ (define %options
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (cons `(query export-manifest) result) (values (cons `(query export-manifest) result)
#f))) #f)))
(option '("export-channels") #f #f
(lambda (opt name arg result arg-handler)
(values (cons `(query export-channels) result)
#f)))
(option '(#\p "profile") #t #f (option '(#\p "profile") #t #f
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (alist-cons 'profile (canonicalize-profile arg) (values (alist-cons 'profile (canonicalize-profile arg)
@ -882,6 +937,12 @@ (define (diff-profiles profile numbers)
(export-manifest manifest (current-output-port)) (export-manifest manifest (current-output-port))
#t)) #t))
(('export-channels)
(let ((manifest (concatenate-manifests
(map profile-manifest profiles))))
(export-channels manifest (current-output-port))
#t))
(_ #f)))) (_ #f))))