scripts: system: Add --target option.

* guix/scripts/system.scm (%options): Add target option,
(%default-options): ditto,
(process-action): Rename existing target variable to target-file and pass new
target variable to run-with-store procedure.
This commit is contained in:
Mathieu Othacehe 2019-08-18 13:09:05 +02:00
parent d4ddf22d54
commit fcc4c6ae60
No known key found for this signature in database
GPG key ID: 8354763531769CA6

View file

@ -2,7 +2,7 @@
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;;
@ -931,6 +931,8 @@ (define (show-help)
--full-boot for 'vm', make a full boot sequence"))
(display (G_ "
--skip-checks skip file system and initrd module safety checks"))
(display (G_ "
--target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
(display (G_ "
-v, --verbosity=LEVEL use the given verbosity LEVEL"))
(newline)
@ -1004,6 +1006,10 @@ (define %options
(lambda (opt name arg result)
(alist-cons 'system arg
(alist-delete 'system result eq?))))
(option '("target") #t #f
(lambda (opt name arg result)
(alist-cons 'target arg
(alist-delete 'target result eq?))))
(option '(#\r "root") #t #f
(lambda (opt name arg result)
(alist-cons 'gc-root arg result)))
@ -1012,6 +1018,7 @@ (define %options
(define %default-options
;; Alist of default option values.
`((system . ,(%current-system))
(target . #f)
(substitutes? . #t)
(offload? . #t)
(print-build-trace? . #t)
@ -1045,6 +1052,7 @@ (define (ensure-operating-system file-or-exp obj)
((x . _) x)))
(expr (assoc-ref opts 'expression))
(system (assoc-ref opts 'system))
(target (assoc-ref opts 'target))
(os (ensure-operating-system
(or file expr)
(cond
@ -1061,7 +1069,7 @@ (define (ensure-operating-system file-or-exp obj)
(dry? (assoc-ref opts 'dry-run?))
(bootloader? (assoc-ref opts 'install-bootloader?))
(target (match args
(target-file (match args
((first second) second)
(_ #f)))
(bootloader-target
@ -1103,9 +1111,10 @@ (define (ensure-operating-system file-or-exp obj)
(_ #f))
opts)
#:install-bootloader? bootloader?
#:target target
#:target target-file
#:bootloader-target bootloader-target
#:gc-root (assoc-ref opts 'gc-root)))))
#:target target
#:system system))
(warn-about-disk-space)))