me
/
guix
Archived
1
0
Fork 0
Code

scripts: system: Honor target argument. 

Since 313f492657 the target argument passed to
"guix system" was not honored for 'disk-image' command.

This forces the command line passed "target" to take precedence over the
"target" field of the <image> record returned by "os->image" procedure.

* guix/scripts/system.scm (system-derivation-for-action): Override the
"target" field of the "image" record using the "target" argument from the
command line.
master
Mathieu Othacehe 2020-10-02 09:53:45 +02:00
parent cc34693152
commit bdbd8bf905
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 34 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
guix/scripts/system.scm
View File

@ -671,36 +671,40 @@ checking this by themselves in their 'check' procedure."
full-boot? container-shared-network? full-boot? container-shared-network?
mappings label) mappings label)
"Return as a monadic value the derivation for OS according to ACTION." "Return as a monadic value the derivation for OS according to ACTION."
(case action (mlet %store-monad ((target (current-target-system)))
((build init reconfigure) (case action
(operating-system-derivation os)) ((build init reconfigure)
((container) (operating-system-derivation os))
(container-script ((container)
os (container-script
#:mappings mappings os
#:shared-network? container-shared-network?)) #:mappings mappings
((vm-image) #:shared-network? container-shared-network?))
(system-qemu-image os #:disk-image-size image-size)) ((vm-image)
((vm) (system-qemu-image os #:disk-image-size image-size))
(system-qemu-image/shared-store-script os ((vm)
#:full-boot? full-boot? (system-qemu-image/shared-store-script os
#:disk-image-size #:full-boot? full-boot?
(if full-boot? #:disk-image-size
image-size (if full-boot?
(* 70 (expt 2 20))) image-size
#:mappings mappings)) (* 70 (expt 2 20)))
((disk-image) #:mappings mappings))
(let ((base-image (os->image os #:type image-type))) ((disk-image)
(lower-object (let* ((base-image (os->image os #:type image-type))
(system-image (base-target (image-target base-image)))
(image (lower-object
(inherit (if label (system-image
(image-with-label base-image label) (image
base-image)) (inherit (if label
(size image-size) (image-with-label base-image label)
(operating-system os)))))) base-image))
((docker-image) (target (or base-target target))
(system-docker-image os #:shared-network? container-shared-network?)))) (size image-size)
(operating-system os))))))
((docker-image)
(system-docker-image os
#:shared-network? container-shared-network?)))))
(define (maybe-suggest-running-guix-pull) (define (maybe-suggest-running-guix-pull)
"Suggest running 'guix pull' if this has never been done before." "Suggest running 'guix pull' if this has never been done before."