[bug#36668] [PATCH 0/1] Add 'eval/container'

[bug#36668] [PATCH 0/1] Add 'eval/container'

[Ludovic Courtès]

Hello Guix!

This adds ‘eval/container’, which can be used to implement things that
are almost derivation (pure computational processes), but not quite:
processes that produce side effects, that need to access the daemon,
or that need to talk over the network.

It doesn’t have any users currently.  Guix-Jupyter-Kernel will probably
use it (to spawn proxied kernels in isolated environments), and I think
Ricardo had a use case for it in GWL too.

What do people think?

I wonder if we should target ‘run-in-container’ instead of
‘call-with-container’, or maybe both.  It’s also a bit troubling
that ‘eval/container’ returns an exit status instead of the evaluation
result, but I think it has to be this way, more or less.

Ludo’.

Ludovic Courtès (1):
  linux-container: Add 'eval/container'.

 gnu/system/linux-container.scm | 49 ++++++++++++++++++++++++++++++++-
 tests/containers.scm           | 50 ++++++++++++++++++++++++++++++++++
 2 files changed, 98 insertions(+), 1 deletion(-)

-- 
2.22.0

[bug#36668] [PATCH 1/1] linux-container: Add 'eval/container'.

[Ludovic Courtès]

* gnu/system/linux-container.scm (eval/container): New procedure.
* tests/containers.scm ("eval/container, exit status")
("eval/container, writable user mapping"): New tests.
---
 gnu/system/linux-container.scm | 49 ++++++++++++++++++++++++++++++++-
 tests/containers.scm           | 50 ++++++++++++++++++++++++++++++++++
 2 files changed, 98 insertions(+), 1 deletion(-)

diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 61248c62b9..6273cee3d3 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -35,7 +35,8 @@
   #:use-module (gnu system file-systems)
   #:export (system-container
             containerized-operating-system
-            container-script))
+            container-script
+            eval/container))
 
 (define* (container-essential-services os #:key shared-network?)
   "Return a list of essential services corresponding to OS, a
@@ -205,3 +206,49 @@ that will be shared with the host system."
                                %namespaces)))))
 
     (gexp->script "run-container" script)))
+
+(define* (eval/container exp
+                         #:key
+                         (mappings '())
+                         (namespaces %namespaces))
+  "Evaluate EXP, a gexp, in a new process executing in separate namespaces as
+listed in NAMESPACES.  Add MAPPINGS, a list of <file-system-mapping>, to the
+set of directories visible in the process's mount namespace.  Return the
+process' exit status as a monadic value.
+
+This is useful to implement processes that, unlike derivations, are not
+entirely pure and need to access the outside world or to perform side
+effects."
+  (mlet %store-monad ((lowered (lower-gexp exp)))
+    (define inputs
+      (cons (lowered-gexp-guile lowered)
+            (lowered-gexp-inputs lowered)))
+
+    (define items
+      (append (append-map derivation-input-output-paths inputs)
+              (lowered-gexp-sources lowered)))
+
+    (mbegin %store-monad
+      (built-derivations inputs)
+      (mlet %store-monad ((closure ((store-lift requisites) items)))
+        (return (call-with-container (map file-system-mapping->bind-mount
+                                          (append (map (lambda (item)
+                                                         (file-system-mapping
+                                                          (source item)
+                                                          (target source)))
+                                                       closure)
+                                                  mappings))
+                  (lambda ()
+                    (apply execl
+                           (string-append (derivation-input-output-path
+                                           (lowered-gexp-guile lowered))
+                                          "/bin/guile")
+                           "guile"
+                           (append (map (lambda (directory) `("-L" ,directory))
+                                        (lowered-gexp-load-path lowered))
+                                   (map (lambda (directory) `("-C" ,directory))
+                                        (lowered-gexp-load-compiled-path
+                                         lowered))
+                                   (list "-c"
+                                         (object->string
+                                          (lowered-gexp-sexp lowered))))))))))))
diff --git a/tests/containers.scm b/tests/containers.scm
index 37408f380d..c6c738f234 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -21,7 +21,15 @@
   #:use-module (guix utils)
   #:use-module (guix build syscalls)
   #:use-module (gnu build linux-container)
+  #:use-module ((gnu system linux-container)
+                #:select (eval/container))
   #:use-module (gnu system file-systems)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:use-module (guix gexp)
+  #:use-module (guix derivations)
+  #:use-module (guix tests)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64)
   #:use-module (ice-9 match))
 
@@ -219,4 +227,46 @@
     (lambda ()
       (* 6 7))))
 
+(skip-if-unsupported)
+(test-equal "eval/container, exit status"
+  42
+  (let* ((store  (open-connection-for-tests))
+         (status (run-with-store store
+                   (eval/container #~(exit 42)))))
+    (close-connection store)
+    (status:exit-val status)))
+
+(skip-if-unsupported)
+(test-assert "eval/container, writable user mapping"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (define store
+       (open-connection-for-tests))
+     (define result
+       (string-append directory "/r"))
+     (define requisites*
+       (store-lift requisites))
+
+     (call-with-output-file result (const #t))
+     (run-with-store store
+       (mlet %store-monad ((status (eval/container
+                                    #~(begin
+                                        (use-modules (ice-9 ftw))
+                                        (call-with-output-file "/result"
+                                          (lambda (port)
+                                            (write (scandir #$(%store-prefix))
+                                                   port))))
+                                    #:mappings
+                                    (list (file-system-mapping
+                                           (source result)
+                                           (target "/result")
+                                           (writable? #t)))))
+                           (reqs   (requisites*
+                                    (list (derivation->output-path
+                                           (%guile-for-build))))))
+         (close-connection store)
+         (return (and (zero? (pk 'status status))
+                      (lset= string=? (cons* "." ".." (map basename reqs))
+                             (pk (call-with-input-file result read))))))))))
+
 (test-end)
-- 
2.22.0

[bug#36668] [PATCH 0/1] Add 'eval/container'

[Thompson, David]

Hi Ludo,

On Mon, Jul 15, 2019 at 10:22 AM Ludovic Courtès <ludo@gnu.org> wrote:
>
> Hello Guix!
>
> This adds ‘eval/container’, which can be used to implement things that
> are almost derivation (pure computational processes), but not quite:
> processes that produce side effects, that need to access the daemon,
> or that need to talk over the network.
>
> It doesn’t have any users currently.  Guix-Jupyter-Kernel will probably
> use it (to spawn proxied kernels in isolated environments), and I think
> Ricardo had a use case for it in GWL too.
>
> What do people think?

This is great.  Love to see 'call-with-container' used for new things.

> I wonder if we should target ‘run-in-container’ instead of
> ‘call-with-container’, or maybe both.

I am behind the times. What is special about 'run-in-container'?

> It’s also a bit troubling
> that ‘eval/container’ returns an exit status instead of the evaluation
> result, but I think it has to be this way, more or less.

I haven't looked at your code, but have you considered supporting
return values that can be serialized via 'write' and then using 'read'
on the host side?  (Hmm, I wonder how exceptions could be passed from
container to host.)

Anyway, nice work!

- Dave

[bug#36668] [PATCH 0/1] Add 'eval/container'

[Ludovic Courtès]

Hello!

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

> On Mon, Jul 15, 2019 at 10:22 AM Ludovic Courtès <ludo@gnu.org> wrote:

[...]

>> I wonder if we should target ‘run-in-container’ instead of
>> ‘call-with-container’, or maybe both.
>
> I am behind the times. What is special about 'run-in-container'?

I actually meant ‘run-container’, which is the lower-level procedure
that ‘call-with-container’ invokes: it returns the PID of the process
that has been created.

>> It’s also a bit troubling
>> that ‘eval/container’ returns an exit status instead of the evaluation
>> result, but I think it has to be this way, more or less.
>
> I haven't looked at your code, but have you considered supporting
> return values that can be serialized via 'write' and then using 'read'
> on the host side?  (Hmm, I wonder how exceptions could be passed from
> container to host.)

I did that in ‘container-excursion*’ a while back, but it’s not
generally applicable (there needs to be a read syntax for what’s sent),
and I think it might be better to build it on top of a more primitive
procedure like this ‘eval/container’.

Whether we need something like this will depend on use cases I guess…

Thanks for your feedback!

Ludo’.

bug#36668: [PATCH 0/1] Add 'eval/container'

[Ludovic Courtès]

Pushed!

Ludo’.