bug#26271: 'guix system' does not support common build option '--root'

[Chris Marusich <cmmarusich@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 2186 bytes --]

Chris Marusich <cmmarusich@gmail.com> writes:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> Hi Chris,
>>
>> Chris Marusich <cmmarusich@gmail.com> skribis:
>>
>>> The manual says ((guix) Invoking guix system) that the options to 'guix
>>> system' "can contain any of the common build options".  Although some
>>> common build options (e.g. '--fallback') do seem to work, I have noticed
>>> that the '--root' option does not.  Consider the following:
>>
>> That’s because ‘--root’ is not a “common build option” in the sense of
>> "(guix) Common Build Options".  :-)
>>
>> That said, I agree we should either make it a common option (i.e., add
>> it to ‘%standard-build-options’ in (guix scripts build)) or add it
>> explicitly to ‘guix system’.  The latter may be simpler.
>>
>> Thoughts?
>
> As long as 'guix system' will create an indirect gc root as expected,
> regardless of whether '--root' was specified in the environment variable
> for build options or as a command-line option for the 'guix system'
> command, adding it explicitly to 'guix system' seems OK to me.
>
> I'll see if I can submit a patch later this week.

I've attached a small patch series which adds support.  Please let me
know what you think.  (If you prefer that I send the patches to you via
some other email list or something, please let me know.)  I've verified
manually that the patches fix the issue.  For example:

--8<---------------cut here---------------start------------->8---
$ GUIX_BUILD_OPTIONS='--root=my-indirect-root' ./pre-inst-env guix system disk-image ~/guix/gnu/system/install.scm
/gnu/store/qr83vk7lifm63jscrv1gfqzj80zwkmca-disk-image
$ ls -l | grep indir
lrwxrwxrwx 1 marusich users       54 Apr  3 23:44 my-indirect-root -> /gnu/store/qr83vk7lifm63jscrv1gfqzj80zwkmca-disk-image
$ ls -l /var/guix/gcroots/auto/ | grep indir
lrwxrwxrwx 1 root root 36 Apr  3 23:44 wk6bx8f7xjq8ab7dz683n64ly21dyw8x -> /home/marusich/guix/my-indirect-root
--8<---------------cut here---------------end--------------->8---

It works the same when I pass the option directly on the command line as
'--root=foo' or '-r foo', too.

-- 
Chris

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-build-Export-register-root-procedure.patch --]
[-- Type: text/x-patch, Size: 799 bytes --]

From ccf03e4bb5d5c2d3a47efdf64e36a7d903bfb2c5 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Mon, 3 Apr 2017 23:47:22 -0700
Subject: [PATCH 1/2] build: Export register-root procedure.

* guix/scripts/build.scm: Export register-root procedure.
---
 guix/scripts/build.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 68402fda1..ba47b1232 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -51,7 +51,8 @@
             options->transformation
             show-transformation-options-help
 
-            guix-build))
+            guix-build
+            register-root))
 
 (define %default-log-urls
   ;; Default base URLs for build logs.
-- 
2.12.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: 0002-system-Support-the-root-option-in-guix-system.patch --]
[-- Type: text/x-patch, Size: 4538 bytes --]

From e96c877459555f4cf868fb5fe4579183f6a773d5 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Mon, 3 Apr 2017 23:49:22 -0700
Subject: [PATCH 2/2] system: Support the --root option in 'guix system'.

Fixes <https://bugs.gnu.org/26271>.

* guix/scripts/system.scm (perform-action): Add parameters 'store' and
  'gc-root'.  Update docstring.
  (perform-action) [gc-root]: Add an indirect GC root using store.
  (%options): Add 'root'.
  (process-action): Pass 'store' and 'root' to perform-action.
---
 guix/scripts/system.scm | 34 +++++++++++++++++++++++-----------
 1 file changed, 23 insertions(+), 11 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 144a7fd37..54a9e1d37 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -589,19 +589,24 @@ PATTERN, a string.  When PATTERN is #f, display all the system generations."
     (warning (_ "Consider running 'guix pull' before 'reconfigure'.~%"))
     (warning (_ "Failing to do that may downgrade your system!~%"))))
 
-(define* (perform-action action os
+(define* (perform-action store action os
                          #:key grub? dry-run? derivations-only?
                          use-substitutes? device target
                          image-size full-boot?
-                         (mappings '()))
-  "Perform ACTION for OS.  GRUB? specifies whether to install GRUB; DEVICE is
-the target devices for GRUB; TARGET is the target root directory; IMAGE-SIZE
-is the size of the image to be built, for the 'vm-image' and 'disk-image'
-actions.  FULL-BOOT? is used for the 'vm' action; it determines whether to
-boot directly to the kernel or to the bootloader.
+                         (mappings '())
+                         (gc-root #f))
+  "Perform ACTION for OS using STORE, which is an open connection to the
+store.  GRUB?  specifies whether to install GRUB; DEVICE is the target devices
+for GRUB; TARGET is the target root directory; IMAGE-SIZE is the size of the
+image to be built, for the 'vm-image' and 'disk-image' actions.  FULL-BOOT? is
+used for the 'vm' action; it determines whether to boot directly to the kernel
+or to the bootloader.
 
 When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
-building anything."
+building anything.
+
+When GC-ROOT is a path, also make that path an indirect root of the build
+output when building a system derivation, such as a disk image."
   (define println
     (cut format #t "~a~%" <>))
 
@@ -666,7 +671,10 @@ building anything."
                       #:device device))
             (else
              ;; All we had to do was to build SYS.
-             (return (derivation->output-path sys))))))))
+             (return (let ((output-path (derivation->output-path sys)))
+                       (if gc-root
+                           (register-root store (list output-path) gc-root)
+                           output-path)))))))))
 
 (define (export-extension-graph os port)
   "Export the service extension graph of OS to PORT."
@@ -797,6 +805,9 @@ Some ACTIONS support additional ARGS.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
                                (alist-delete 'system result eq?))))
+         (option '(#\r "root") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'gc-root arg result)))
          %standard-build-options))
 
 (define %default-options
@@ -850,7 +861,7 @@ resulting from command-line parsing."
             ((shepherd-graph)
              (export-shepherd-graph os (current-output-port)))
             (else
-             (perform-action action os
+             (perform-action store action os
                              #:dry-run? dry?
                              #:derivations-only? (assoc-ref opts
                                                             'derivations-only?)
@@ -863,7 +874,8 @@ resulting from command-line parsing."
                                                       (_ #f))
                                                     opts)
                              #:grub? grub?
-                             #:target target #:device device))))
+                             #:target target #:device device
+                             #:gc-root (assoc-ref opts 'gc-root)))))
         #:system system))))
 
 (define (process-command command args opts)
-- 
2.12.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]