me/guix
Archived
1
0
Fork 0
Code Activity

guix system: Add '--system' option.

Browse source 
* guix/scripts/system.scm (switch-to-system): Add #:system parameter;
  pass it to 'run-with-store'.
  (%options): Add '--system'.
  (guix-system): Pass the 'system' option to 'run-with-store',
  'package-derivation', and 'switch-to-system' calls.
* doc/guix.texi (Invoking guix system): Document '--system' and
  '--image-size'.
This commit is contained in:
Ludovic Courtès 2014-07-08 23:42:35 +02:00
parent 35dbbbe04c
commit df2ce34385
2 changed files with 34 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
doc/guix.texi
View file

@ -3445,7 +3445,21 @@ using the following command:
@end table @end table
@var{options} can contain any of the common build options provided by @var{options} can contain any of the common build options provided by
@command{guix build} (@pxref{Invoking guix build}). @command{guix build} (@pxref{Invoking guix build}). In addition,
@var{options} can contain one of the following:
@table @option
@item --system=@var{system}
@itemx -s @var{system}
Attempt to build for @var{system} instead of the host's system type.
This works as per @command{guix build} (@pxref{Invoking guix build}).
@item --image-size=@var{size}
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
include a unit as a suffix, such as @code{MiB} for mebibytes and
@code{GB} for gigabytes.
@end table
Note that all the actions above, except @code{build} and @code{init}, Note that all the actions above, except @code{build} and @code{init},
rely on KVM support in the Linux-Libre kernel. Specifically, the rely on KVM support in the Linux-Libre kernel. Specifically, the

29
guix/scripts/system.scm
View file

@ -131,11 +131,12 @@ When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG."
;; The system profile. ;; The system profile.
(string-append %state-directory "/profiles/system")) (string-append %state-directory "/profiles/system"))
(define* (switch-to-system store os system (define* (switch-to-system store os system-directory
#:optional (profile %system-profile)) #:optional (profile %system-profile)
"Make a new generation of PROFILE pointing to SYSTEM, which is the directory #:key system)
corresponding to OS, switch to it atomically, and then run OS's activation "Make a new generation of PROFILE pointing to SYSTEM-DIRECTORY, which is the
script." directory corresponding to OS on SYSTEM, switch to it atomically, and then run
OS's activation script."
(let* ((number (+ 1 (generation-number profile))) (let* ((number (+ 1 (generation-number profile)))
(generation (generation-file-name profile number))) (generation (generation-file-name profile number)))
(symlink system generation) (symlink system generation)
@ -144,7 +145,8 @@ script."
(run-with-store store (run-with-store store
(mlet %store-monad ((script (operating-system-activation-script os))) (mlet %store-monad ((script (operating-system-activation-script os)))
(format #t (_ "activating system...~%")) (format #t (_ "activating system...~%"))
(return (primitive-load (derivation->output-path script))))) (return (primitive-load (derivation->output-path script))))
#:system system)
;; TODO: Run 'deco reload ...'. ;; TODO: Run 'deco reload ...'.
)) ))
@ -241,6 +243,10 @@ Build the operating system declared in FILE according to ACTION.\n"))
(option '(#\n "dry-run") #f #f (option '(#\n "dry-run") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'dry-run? #t result))) (alist-cons 'dry-run? #t result)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg
(alist-delete 'system result eq?))))
%standard-build-options)) %standard-build-options))
(define %default-options (define %default-options
@ -305,6 +311,7 @@ Build the operating system declared in FILE according to ACTION.\n"))
(args (option-arguments opts)) (args (option-arguments opts))
(file (first args)) (file (first args))
(action (assoc-ref opts 'action)) (action (assoc-ref opts 'action))
(system (assoc-ref opts 'system))
(os (if file (os (if file
(read-operating-system file) (read-operating-system file)
(leave (_ "no configuration file specified~%")))) (leave (_ "no configuration file specified~%"))))
@ -323,12 +330,13 @@ Build the operating system declared in FILE according to ACTION.\n"))
#:disk-image-size size))))) #:disk-image-size size)))))
(store (open-connection)) (store (open-connection))
(dry? (assoc-ref opts 'dry-run?)) (dry? (assoc-ref opts 'dry-run?))
(drv (run-with-store store mdrv)) (drv (run-with-store store mdrv #:system system))
(grub? (assoc-ref opts 'install-grub?)) (grub? (assoc-ref opts 'install-grub?))
(old (previous-grub-entries)) (old (previous-grub-entries))
(grub.cfg (run-with-store store (grub.cfg (run-with-store store
(operating-system-grub.cfg os old))) (operating-system-grub.cfg os old)
(grub (package-derivation store grub)) #:system system))
(grub (package-derivation store grub system))
(drv-lst (if grub? (drv-lst (if grub?
(list drv grub grub.cfg) (list drv grub grub.cfg)
(list drv)))) (list drv))))
@ -357,7 +365,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
(operating-system-bootloader os))))) (operating-system-bootloader os)))))
(case action (case action
((reconfigure) ((reconfigure)
(switch-to-system store os (derivation->output-path drv)) (switch-to-system store os (derivation->output-path drv)
#:system system)
(when grub? (when grub?
(unless (install-grub grub.cfg device target) (unless (install-grub grub.cfg device target)
(leave (_ "failed to install GRUB on device '~a'~%") device)))) (leave (_ "failed to install GRUB on device '~a'~%") device))))