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

8
guix/scripts/system.scm
View File

@ -671,6 +671,7 @@ 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."
(mlet %store-monad ((target (current-target-system)))
(case action (case action
((build init reconfigure) ((build init reconfigure)
(operating-system-derivation os)) (operating-system-derivation os))
@ -690,17 +691,20 @@ checking this by themselves in their 'check' procedure."
(* 70 (expt 2 20))) (* 70 (expt 2 20)))
#:mappings mappings)) #:mappings mappings))
((disk-image) ((disk-image)
(let ((base-image (os->image os #:type image-type))) (let* ((base-image (os->image os #:type image-type))
(base-target (image-target base-image)))
(lower-object (lower-object
(system-image (system-image
(image (image
(inherit (if label (inherit (if label
(image-with-label base-image label) (image-with-label base-image label)
base-image)) base-image))
(target (or base-target target))
(size image-size) (size image-size)
(operating-system os)))))) (operating-system os))))))
((docker-image) ((docker-image)
(system-docker-image os #:shared-network? container-shared-network?)))) (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."