From df2ce34385376ea895580d2a3e9d75e64790919d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 8 Jul 2014 23:42:35 +0200
Subject: guix system: Add '--system' option.

* 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'.
---
 guix/scripts/system.scm | 29 +++++++++++++++++++----------
 1 file changed, 19 insertions(+), 10 deletions(-)

(limited to 'guix')

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0c1bff94b6..e922f420b4 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -131,11 +131,12 @@ (define %system-profile
   ;; The system profile.
   (string-append %state-directory "/profiles/system"))
 
-(define* (switch-to-system store os system
-                           #:optional (profile %system-profile))
-  "Make a new generation of PROFILE pointing to SYSTEM, which is the directory
-corresponding to OS, switch to it atomically, and then run OS's activation
-script."
+(define* (switch-to-system store os system-directory
+                           #:optional (profile %system-profile)
+                           #:key system)
+  "Make a new generation of PROFILE pointing to SYSTEM-DIRECTORY, which is the
+directory corresponding to OS on SYSTEM, switch to it atomically, and then run
+OS's activation script."
   (let* ((number     (+ 1 (generation-number profile)))
          (generation (generation-file-name profile number)))
     (symlink system generation)
@@ -144,7 +145,8 @@ (define* (switch-to-system store os system
     (run-with-store store
       (mlet %store-monad ((script (operating-system-activation-script os)))
         (format #t (_ "activating system...~%"))
-        (return (primitive-load (derivation->output-path script)))))
+        (return (primitive-load (derivation->output-path script))))
+      #:system system)
 
     ;; TODO: Run 'deco reload ...'.
     ))
@@ -241,6 +243,10 @@ (define %options
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg 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))
 
 (define %default-options
@@ -305,6 +311,7 @@ (define (fail)
            (args     (option-arguments opts))
            (file     (first args))
            (action   (assoc-ref opts 'action))
+           (system   (assoc-ref opts 'system))
            (os       (if file
                          (read-operating-system file)
                          (leave (_ "no configuration file specified~%"))))
@@ -323,12 +330,13 @@ (define (fail)
                                              #:disk-image-size size)))))
            (store    (open-connection))
            (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?))
            (old      (previous-grub-entries))
            (grub.cfg (run-with-store store
-                       (operating-system-grub.cfg os old)))
-           (grub     (package-derivation store grub))
+                       (operating-system-grub.cfg os old)
+                       #:system system))
+           (grub     (package-derivation store grub system))
            (drv-lst  (if grub?
                          (list drv grub grub.cfg)
                          (list drv))))
@@ -357,7 +365,8 @@ (define (fail)
                             (operating-system-bootloader os)))))
           (case action
             ((reconfigure)
-             (switch-to-system store os (derivation->output-path drv))
+             (switch-to-system store os (derivation->output-path drv)
+                               #:system system)
              (when grub?
                (unless (install-grub grub.cfg device target)
                  (leave (_ "failed to install GRUB on device '~a'~%") device))))
-- 
cgit v1.2.3