[PATCH] system: container: Update to new service API.

[PATCH] system: container: Update to new service API.

[David Thompson]

[-- Attachment #1: Type: text/plain, Size: 85 bytes --]

Getting up to speed with the changes that were made during the service
API rewrite.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-scripts-build-Add-file-option.patch --]
[-- Type: text/x-patch, Size: 5489 bytes --]

From d3dd1b2d05f17702f7fa6095132db00e2146e702 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 26 Oct 2015 18:09:28 -0400
Subject: [PATCH] scripts: build: Add --file option.

* guix/scripts/build.scm (show-help): Add help text for --file option.
  (%options): Add --file option.
  (options/resolve-packages): Handle 'file' options.
* tests/guix-build.sh: Add tests.
* doc/guix.texi ("invoking guix build"): Add doc.
---
 doc/guix.texi          | 13 +++++++++++++
 guix/scripts/build.scm | 45 ++++++++++++++++++++++++++++-----------------
 tests/guix-build.sh    | 27 +++++++++++++++++++++++++++
 3 files changed, 68 insertions(+), 17 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 7715b72..abd8de3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3615,6 +3615,19 @@ The @var{options} may be zero or more of the following:
 
 @table @code
 
+@item --file=@var{file}
+@itemx -e @var{file}
+
+Build the package or derivation that the code within @var{file}
+evaluates to.
+
+As an example, @var{file} might contain a package definition like this
+(@pxref{Defining Packages}):
+
+@example
+@verbatiminclude package-hello.scm
+@end example
+
 @item --expression=@var{expr}
 @itemx -e @var{expr}
 Build the package or derivation @var{expr} evaluates to.
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index a357cf8..ee7e5b9 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -290,6 +290,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
   (display (_ "
   -e, --expression=EXPR  build the package or derivation EXPR evaluates to"))
   (display (_ "
+  -f, --file=FILE        build the package or derivation that the code within
+                         FILE evaluates to"))
+  (display (_ "
   -S, --source           build the packages' source derivations"))
   (display (_ "
       --sources[=TYPE]   build source derivations; TYPE may optionally be one
@@ -359,6 +362,9 @@ must be one of 'package', 'all', or 'transitive'~%")
          (option '(#\e "expression") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'expression arg result)))
+         (option '(#\f "file") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'file arg result)))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t result)))
@@ -422,29 +428,34 @@ packages."
   (define system
     (or (assoc-ref opts 'system) (%current-system)))
 
+  (define (object->argument obj)
+    (match obj
+      ((? package? p)
+       `(argument . ,p))
+      ((? procedure? proc)
+       (let ((drv (run-with-store store
+                    (mbegin %store-monad
+                      (set-guile-for-build (default-guile))
+                      (proc))
+                    #:system system)))
+         `(argument . ,drv)))
+      ((? gexp? gexp)
+       (let ((drv (run-with-store store
+                    (mbegin %store-monad
+                      (set-guile-for-build (default-guile))
+                      (gexp->derivation "gexp" gexp
+                                        #:system system)))))
+         `(argument . ,drv)))))
+
   (map (match-lambda
         (('argument . (? string? spec))
          (if (store-path? spec)
              `(argument . ,spec)
              `(argument . ,(specification->package spec))))
+        (('file . file)
+         (object->argument (load* file (make-user-module '()))))
         (('expression . str)
-         (match (read/eval str)
-           ((? package? p)
-            `(argument . ,p))
-           ((? procedure? proc)
-            (let ((drv (run-with-store store
-                         (mbegin %store-monad
-                           (set-guile-for-build (default-guile))
-                           (proc))
-                         #:system system)))
-              `(argument . ,drv)))
-           ((? gexp? gexp)
-            (let ((drv (run-with-store store
-                         (mbegin %store-monad
-                           (set-guile-for-build (default-guile))
-                           (gexp->derivation "gexp" gexp
-                                             #:system system)))))
-              `(argument . ,drv)))))
+         (object->argument (read/eval str)))
         (opt opt))
        opts))
 
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index a72ce09..f7fb3c5 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -167,6 +167,33 @@ guix build -e "(begin
 guix build -e '#~(mkdir #$output)' -d
 guix build -e '#~(mkdir #$output)' -d | grep 'gexp\.drv'
 
+# Building from a package file.
+cat > "$module_dir/package.scm"<<EOF
+(use-modules (gnu))
+(use-package-modules bootstrap)
+
+%bootstrap-guile
+EOF
+guix build --file="$module_dir/package.scm"
+
+# Building from a monadic procedure file.
+cat > "$module_dir/proc.scm"<<EOF
+(use-modules (guix gexp))
+(lambda ()
+  (gexp->derivation "test"
+                    (gexp (mkdir (ungexp output)))))
+EOF
+guix build --file="$module_dir/proc.scm" --dry-run
+
+# Building from a gexp file.
+cat > "$module_dir/gexp.scm"<<EOF
+(use-modules (guix gexp))
+
+(gexp (mkdir (ungexp output)))
+EOF
+guix build --file="$module_dir/gexp.scm" -d
+guix build --file="$module_dir/gexp.scm" -d | grep 'gexp\.drv'
+
 # Using 'GUIX_BUILD_OPTIONS'.
 GUIX_BUILD_OPTIONS="--dry-run"
 export GUIX_BUILD_OPTIONS
-- 
2.5.0


[-- Attachment #3: Type: text/plain, Size: 38 bytes --]


-- 
David Thompson
GPG Key: 0FF1D807

Re: [PATCH] system: container: Update to new service API.

[Thompson, David]

[-- Attachment #1: Type: text/plain, Size: 221 bytes --]

On Mon, Oct 26, 2015 at 8:19 PM, David Thompson
<dthompson2@worcester.edu> wrote:
> Getting up to speed with the changes that were made during the service
> API rewrite.

Sorry, wrong patch file!  Here's the correct one.

[-- Attachment #2: 0001-system-container-Update-to-new-service-API.patch --]
[-- Type: text/x-diff, Size: 4855 bytes --]

From 54f221aa3dda8596a4b3bc57a0e911b5c8ce37c9 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 26 Oct 2015 20:12:55 -0400
Subject: [PATCH] system: container: Update to new service API.

* gnu/services.scm (activation-script->script): Add #:container?
  argument.
  (activation-script): Add #:container? argument.  Omit kernel tweaks
  when creating a script for a container.
* gnu/system.scm (operating-system-activation-script): Pass #:container?
  argument to 'activation-service->script'.
* gnu/system/linux-container.scm (system-container): Fix breaking
  changes introduced by new <computed-file> data type.
---
 gnu/services.scm               | 22 +++++++++++++---------
 gnu/system.scm                 |  2 +-
 gnu/system/linux-container.scm | 14 ++++++++------
 3 files changed, 22 insertions(+), 16 deletions(-)

diff --git a/gnu/services.scm b/gnu/services.scm
index d0fe0ad..cb4987d 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -216,13 +216,15 @@ variable is not set---hence the need for this wrapper."
                       (apply execl #$modprobe
                              (cons #$modprobe (cdr (command-line))))))))
 
-(define* (activation-service->script service)
+(define* (activation-service->script service #:key container?)
   "Return as a monadic value the activation script for SERVICE, a service of
-ACTIVATION-SCRIPT-TYPE."
-  (activation-script (service-parameters service)))
+ACTIVATION-SCRIPT-TYPE.  When CONTAINER? is true, build the container variant
+of the script."
+  (activation-script (service-parameters service) #:container? container?))
 
-(define (activation-script gexps)
-  "Return the system's activation script, which evaluates GEXPS."
+(define* (activation-script gexps #:key container?)
+  "Return the system's activation script, which evaluates GEXPS.  When
+CONTAINER? is true, return a script suitable for a Linux container."
   (define %modules
     '((gnu build activation)
       (gnu build linux-boot)
@@ -256,11 +258,13 @@ ACTIVATION-SCRIPT-TYPE."
                     (activate-/bin/sh
                      (string-append #$(canonical-package bash) "/bin/sh"))
 
-                    ;; Tell the kernel to use our 'modprobe' command.
-                    (activate-modprobe #$modprobe)
+                    #$@(if container?
+                           ;; Tell the kernel to use our 'modprobe' command.
+                           #~((activate-modprobe #$modprobe)
 
-                    ;; Let users debug their own processes!
-                    (activate-ptrace-attach)
+                              ;; Let users debug their own processes!
+                              (activate-ptrace-attach))
+                           #~())
 
                     ;; Run the services' activation snippets.
                     ;; TODO: Use 'load-compiled'.
diff --git a/gnu/system.scm b/gnu/system.scm
index aa76882..0ab0094 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -599,7 +599,7 @@ etc."
   (let* ((services   (operating-system-services os #:container? container?))
          (activation (fold-services services
                                     #:target-type activation-service-type)))
-    (activation-service->script activation)))
+    (activation-service->script activation #:container? container?)))
 
 (define* (operating-system-boot-script os #:key container?)
   "Return the boot script for OS---i.e., the code started by the initrd once
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index fdf7460..abe816f 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -25,6 +25,7 @@
   #:use-module (guix derivations)
   #:use-module (guix monads)
   #:use-module (gnu build linux-container)
+  #:use-module (gnu services)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
   #:export (mapping->file-system
@@ -50,14 +51,15 @@
   "Return a derivation that builds OS as a Linux container."
   (mlet* %store-monad
       ((profile (operating-system-profile os))
-       (etc     (operating-system-etc-directory os))
+       (etc  -> (operating-system-etc-directory os))
        (boot    (operating-system-boot-script os #:container? #t))
        (locale  (operating-system-locale-directory os)))
-    (file-union "system-container"
-                `(("boot" ,#~#$boot)
-                  ("profile" ,#~#$profile)
-                  ("locale" ,#~#$locale)
-                  ("etc" ,#~#$etc)))))
+    (lower-object
+     (file-union "system-container"
+                 `(("boot" ,#~#$boot)
+                   ("profile" ,#~#$profile)
+                   ("locale" ,#~#$locale)
+                   ("etc" ,#~#$etc))))))
 
 (define (containerized-operating-system os mappings)
   "Return an operating system based on OS for use in a Linux container
-- 
2.5.0

Re: [PATCH] system: container: Update to new service API.

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 417 bytes --]

Sorry, I meant to preserve #:container? behavior but I forgot this bit.

I believe the attached patch provides an Even Greater Way to address the
problem, namely by making the modprobe/firmware thing an optional
service.

Could you try and report back?  I tried it in a VM and there’s no
regression.

Besides, we’ll have to make sure ‘guix system extension-graph’ honors
--container.

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 4781 bytes --]

diff --git a/gnu/services.scm b/gnu/services.scm
index d0fe0ad..a02d79e 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -62,6 +62,7 @@
             boot-service-type
             activation-service-type
             activation-service->script
+            %linux-bare-metal-service
             etc-service-type
             etc-directory
             setuid-program-service-type
@@ -202,20 +203,6 @@ file."
                         (union-build #$output '#$things))
                     #:modules '((guix build union))))))
 
-(define (modprobe-wrapper)
-  "Return a wrapper for the 'modprobe' command that knows where modules live.
-
-This wrapper is typically invoked by the Linux kernel ('call_modprobe', in
-kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY' environment
-variable is not set---hence the need for this wrapper."
-  (let ((modprobe "/run/current-system/profile/bin/modprobe"))
-    (gexp->script "modprobe"
-                  #~(begin
-                      (setenv "LINUX_MODULE_DIRECTORY"
-                              "/run/booted-system/kernel/lib/modules")
-                      (apply execl #$modprobe
-                             (cons #$modprobe (cdr (command-line))))))))
-
 (define* (activation-service->script service)
   "Return as a monadic value the activation script for SERVICE, a service of
 ACTIVATION-SCRIPT-TYPE."
@@ -240,8 +227,7 @@ ACTIVATION-SCRIPT-TYPE."
 
   (mlet* %store-monad ((actions  (service-activations))
                        (modules  (imported-modules %modules))
-                       (compiled (compiled-modules %modules))
-                       (modprobe (modprobe-wrapper)))
+                       (compiled (compiled-modules %modules)))
     (gexp->file "activate"
                 #~(begin
                     (eval-when (expand load eval)
@@ -256,12 +242,6 @@ ACTIVATION-SCRIPT-TYPE."
                     (activate-/bin/sh
                      (string-append #$(canonical-package bash) "/bin/sh"))
 
-                    ;; Tell the kernel to use our 'modprobe' command.
-                    (activate-modprobe #$modprobe)
-
-                    ;; Let users debug their own processes!
-                    (activate-ptrace-attach)
-
                     ;; Run the services' activation snippets.
                     ;; TODO: Use 'load-compiled'.
                     (for-each primitive-load '#$actions)
@@ -287,6 +267,41 @@ ACTIVATION-SCRIPT-TYPE."
   ;; receives.
   (service activation-service-type #t))
 
+(define %modprobe-wrapper
+  ;; Wrapper for the 'modprobe' command that knows where modules live.
+  ;;
+  ;; This wrapper is typically invoked by the Linux kernel ('call_modprobe',
+  ;; in kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY'
+  ;; environment variable is not set---hence the need for this wrapper.
+  (let ((modprobe "/run/current-system/profile/bin/modprobe"))
+    (program-file "modprobe"
+                  #~(begin
+                      (setenv "LINUX_MODULE_DIRECTORY"
+                              "/run/booted-system/kernel/lib/modules")
+                      (apply execl #$modprobe
+                             (cons #$modprobe (cdr (command-line))))))))
+
+(define %linux-kernel-activation
+  ;; Activation of the Linux kernel running on the bare metal (as opposed to
+  ;; running in a container.)
+  #~(begin
+      ;; Tell the kernel to use our 'modprobe' command.
+      (activate-modprobe #$%modprobe-wrapper)
+
+      ;; Let users debug their own processes!
+      (activate-ptrace-attach)))
+
+(define linux-bare-metal-service-type
+  (service-type (name 'linux-bare-metal)
+                (extensions
+                 (list (service-extension activation-service-type
+                                          (const %linux-kernel-activation))))))
+
+(define %linux-bare-metal-service
+  ;; The service that does things that are needed on the "bare metal", but not
+  ;; necessary or impossible in a container.
+  (service linux-bare-metal-service-type #f))
+
 (define (etc-directory service)
   "Return the directory for SERVICE, a service of type ETC-SERVICE-TYPE."
   (files->etc-directory (service-parameters service)))
diff --git a/gnu/system.scm b/gnu/system.scm
index aa76882..de85156 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -290,7 +290,8 @@ a container or that of a \"bare metal\" system."
                    ;; container.
                    (if container?
                        '()
-                       (list (service firmware-service-type
+                       (list %linux-bare-metal-service
+                             (service firmware-service-type
                                       (operating-system-firmware os))))))))
 
 (define* (operating-system-services os #:key container?)

Re: [PATCH] system: container: Update to new service API.

[Thompson, David]

On Tue, Oct 27, 2015 at 9:22 AM, Ludovic Courtès <ludo@gnu.org> wrote:
> Sorry, I meant to preserve #:container? behavior but I forgot this bit.
>
> I believe the attached patch provides an Even Greater Way to address the
> problem, namely by making the modprobe/firmware thing an optional
> service.
>
> Could you try and report back?  I tried it in a VM and there’s no
> regression.

It works great, thanks!  If you make a commit from this, I will reduce
this patch to simply fixing gnu/system/linux-container.scm.

> Besides, we’ll have to make sure ‘guix system extension-graph’ honors
> --container.

Hmm, yes, good point. I haven't looked at that code at all since it is so new.

- Dave

Re: [PATCH] system: container: Update to new service API.

[Ludovic Courtès]

"Thompson, David" <dthompson2@worcester.edu> skribis:

> On Tue, Oct 27, 2015 at 9:22 AM, Ludovic Courtès <ludo@gnu.org> wrote:
>> Sorry, I meant to preserve #:container? behavior but I forgot this bit.
>>
>> I believe the attached patch provides an Even Greater Way to address the
>> problem, namely by making the modprobe/firmware thing an optional
>> service.
>>
>> Could you try and report back?  I tried it in a VM and there’s no
>> regression.
>
> It works great, thanks!

Applied!

Ludo’.

Re: [PATCH] system: container: Update to new service API.

[Thompson, David]

[-- Attachment #1: Type: text/plain, Size: 640 bytes --]

On Thu, Oct 29, 2015 at 6:00 PM, Ludovic Courtès <ludo@gnu.org> wrote:
> "Thompson, David" <dthompson2@worcester.edu> skribis:
>
>> On Tue, Oct 27, 2015 at 9:22 AM, Ludovic Courtès <ludo@gnu.org> wrote:
>>> Sorry, I meant to preserve #:container? behavior but I forgot this bit.
>>>
>>> I believe the attached patch provides an Even Greater Way to address the
>>> problem, namely by making the modprobe/firmware thing an optional
>>> service.
>>>
>>> Could you try and report back?  I tried it in a VM and there’s no
>>> regression.
>>
>> It works great, thanks!
>
> Applied!

Thanks!  Here's the new patch.

- Dave

[-- Attachment #2: 0001-system-container-Adjust-to-changes-in-gexps.patch --]
[-- Type: text/x-diff, Size: 1862 bytes --]

From 750131550354a25541a3adcdd983f4053bb86cc9 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Thu, 29 Oct 2015 00:15:36 -0400
Subject: [PATCH] system: container: Adjust to changes in gexps.

* gnu/system/linux-container.scm (system-container): 'etc' is no longer
  a monadic value, and the result of 'file-union' must be lowered.
---
 gnu/system/linux-container.scm | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index fdf7460..abe816f 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -25,6 +25,7 @@
   #:use-module (guix derivations)
   #:use-module (guix monads)
   #:use-module (gnu build linux-container)
+  #:use-module (gnu services)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
   #:export (mapping->file-system
@@ -50,14 +51,15 @@
   "Return a derivation that builds OS as a Linux container."
   (mlet* %store-monad
       ((profile (operating-system-profile os))
-       (etc     (operating-system-etc-directory os))
+       (etc  -> (operating-system-etc-directory os))
        (boot    (operating-system-boot-script os #:container? #t))
        (locale  (operating-system-locale-directory os)))
-    (file-union "system-container"
-                `(("boot" ,#~#$boot)
-                  ("profile" ,#~#$profile)
-                  ("locale" ,#~#$locale)
-                  ("etc" ,#~#$etc)))))
+    (lower-object
+     (file-union "system-container"
+                 `(("boot" ,#~#$boot)
+                   ("profile" ,#~#$profile)
+                   ("locale" ,#~#$locale)
+                   ("etc" ,#~#$etc))))))
 
 (define (containerized-operating-system os mappings)
   "Return an operating system based on OS for use in a Linux container
-- 
2.5.0

Re: [PATCH] system: container: Update to new service API.

[Ludovic Courtès]

"Thompson, David" <dthompson2@worcester.edu> skribis:

> From 750131550354a25541a3adcdd983f4053bb86cc9 Mon Sep 17 00:00:00 2001
> From: David Thompson <dthompson2@worcester.edu>
> Date: Thu, 29 Oct 2015 00:15:36 -0400
> Subject: [PATCH] system: container: Adjust to changes in gexps.
>
> * gnu/system/linux-container.scm (system-container): 'etc' is no longer
>   a monadic value, and the result of 'file-union' must be lowered.

LGTM, thanks!

(And sorry for the unintended breakage.)

Ludo’.