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

["Thompson, David" <dthompson2@worcester.edu>]

[-- 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