guix system: Add '--derivation'.
* guix/scripts/system.scm (perform-action): Add #:derivations-only? parameter and honor it. (show-help, %options): Add '--derivation'. (guix-system): Pass #:derivations-only? to 'perform-action'. * tests/guix-system.sh: Test it. * doc/guix.texi (Invoking guix system): Document it.
This commit is contained in:
parent
23afe939a2
commit
f3f427c2e9
@ -6916,6 +6916,11 @@ using the following command:
|
|||||||
Attempt to build for @var{system} instead of the host's system type.
|
Attempt to build for @var{system} instead of the host's system type.
|
||||||
This works as per @command{guix build} (@pxref{Invoking guix build}).
|
This works as per @command{guix build} (@pxref{Invoking guix build}).
|
||||||
|
|
||||||
|
@item --derivation
|
||||||
|
@itemx -d
|
||||||
|
Return the derivation file name of the given operating system without
|
||||||
|
building anything.
|
||||||
|
|
||||||
@item --image-size=@var{size}
|
@item --image-size=@var{size}
|
||||||
For the @code{vm-image} and @code{disk-image} actions, create an image
|
For the @code{vm-image} and @code{disk-image} actions, create an image
|
||||||
of the given @var{size}. @var{size} may be a number of bytes, or it may
|
of the given @var{size}. @var{size} may be a number of bytes, or it may
|
||||||
|
@ -300,7 +300,7 @@ it atomically, and then run OS's activation script."
|
|||||||
(system-disk-image os #:disk-image-size image-size))))
|
(system-disk-image os #:disk-image-size image-size))))
|
||||||
|
|
||||||
(define* (perform-action action os
|
(define* (perform-action action os
|
||||||
#:key grub? dry-run?
|
#:key grub? dry-run? derivations-only?
|
||||||
use-substitutes? device target
|
use-substitutes? device target
|
||||||
image-size full-boot?
|
image-size full-boot?
|
||||||
(mappings '()))
|
(mappings '()))
|
||||||
@ -308,7 +308,13 @@ it atomically, and then run OS's activation script."
|
|||||||
the target devices for GRUB; TARGET is the target root directory; IMAGE-SIZE
|
the target devices for GRUB; TARGET is the target root directory; IMAGE-SIZE
|
||||||
is the size of the image to be built, for the 'vm-image' and 'disk-image'
|
is the size of the image to be built, for the 'vm-image' and 'disk-image'
|
||||||
actions. FULL-BOOT? is used for the 'vm' action; it determines whether to
|
actions. FULL-BOOT? is used for the 'vm' action; it determines whether to
|
||||||
boot directly to the kernel or to the bootloader."
|
boot directly to the kernel or to the bootloader.
|
||||||
|
|
||||||
|
When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
|
||||||
|
building anything."
|
||||||
|
(define println
|
||||||
|
(cut format #t "~a~%" <>))
|
||||||
|
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((sys (system-derivation-for-action os action
|
((sys (system-derivation-for-action os action
|
||||||
#:image-size image-size
|
#:image-size image-size
|
||||||
@ -322,14 +328,17 @@ boot directly to the kernel or to the bootloader."
|
|||||||
(drvs -> (if (and grub? (memq action '(init reconfigure)))
|
(drvs -> (if (and grub? (memq action '(init reconfigure)))
|
||||||
(list sys grub grub.cfg)
|
(list sys grub grub.cfg)
|
||||||
(list sys)))
|
(list sys)))
|
||||||
(% (maybe-build drvs #:dry-run? dry-run?
|
(% (if derivations-only?
|
||||||
#:use-substitutes? use-substitutes?)))
|
(return (for-each (compose println derivation-file-name)
|
||||||
|
drvs))
|
||||||
|
(maybe-build drvs #:dry-run? dry-run?
|
||||||
|
#:use-substitutes? use-substitutes?))))
|
||||||
|
|
||||||
(if dry-run?
|
(if (or dry-run? derivations-only?)
|
||||||
(return #f)
|
(return #f)
|
||||||
(begin
|
(begin
|
||||||
(for-each (cut format #t "~a~%" <>)
|
(for-each (compose println derivation->output-path)
|
||||||
(map derivation->output-path drvs))
|
drvs)
|
||||||
|
|
||||||
;; Make sure GRUB is accessible.
|
;; Make sure GRUB is accessible.
|
||||||
(when grub?
|
(when grub?
|
||||||
@ -382,6 +391,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
|
|||||||
init initialize a root file system to run GNU.\n"))
|
init initialize a root file system to run GNU.\n"))
|
||||||
|
|
||||||
(show-build-options-help)
|
(show-build-options-help)
|
||||||
|
(display (_ "
|
||||||
|
-d, --derivation return the derivation of the given system"))
|
||||||
(display (_ "
|
(display (_ "
|
||||||
--on-error=STRATEGY
|
--on-error=STRATEGY
|
||||||
apply STRATEGY when an error occurs while reading FILE"))
|
apply STRATEGY when an error occurs while reading FILE"))
|
||||||
@ -425,6 +436,9 @@ Build the operating system declared in FILE according to ACTION.\n"))
|
|||||||
(option '(#\V "version") #f #f
|
(option '(#\V "version") #f #f
|
||||||
(lambda args
|
(lambda args
|
||||||
(show-version-and-exit "guix system")))
|
(show-version-and-exit "guix system")))
|
||||||
|
(option '(#\d "derivation") #f #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-cons 'derivations-only? #t result)))
|
||||||
(option '("on-error") #t #f
|
(option '("on-error") #t #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'on-error (string->symbol arg)
|
(alist-cons 'on-error (string->symbol arg)
|
||||||
@ -549,6 +563,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
|
|||||||
(set-guile-for-build (default-guile))
|
(set-guile-for-build (default-guile))
|
||||||
(perform-action action os
|
(perform-action action os
|
||||||
#:dry-run? dry?
|
#:dry-run? dry?
|
||||||
|
#:derivations-only? (assoc-ref opts
|
||||||
|
'derivations-only?)
|
||||||
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
||||||
#:image-size (assoc-ref opts 'image-size)
|
#:image-size (assoc-ref opts 'image-size)
|
||||||
#:full-boot? (assoc-ref opts 'full-boot?)
|
#:full-boot? (assoc-ref opts 'full-boot?)
|
||||||
|
@ -132,6 +132,12 @@ EOF
|
|||||||
make_user_config "users" "wheel"
|
make_user_config "users" "wheel"
|
||||||
guix system build "$tmpfile" -n # succeeds
|
guix system build "$tmpfile" -n # succeeds
|
||||||
|
|
||||||
|
guix system build "$tmpfile" -d # succeeds
|
||||||
|
guix system build "$tmpfile" -d | grep '\.drv$'
|
||||||
|
|
||||||
|
guix system vm "$tmpfile" -d # succeeds
|
||||||
|
guix system vm "$tmpfile" -d | grep '\.drv$'
|
||||||
|
|
||||||
make_user_config "group-that-does-not-exist" "users"
|
make_user_config "group-that-does-not-exist" "users"
|
||||||
if guix system build "$tmpfile" -n 2> "$errorfile"
|
if guix system build "$tmpfile" -n 2> "$errorfile"
|
||||||
then false
|
then false
|
||||||
|
Loading…
Reference in New Issue
Block a user