[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gwl-devel] support for containers
From: |
Ricardo Wurmus |
Subject: |
[gwl-devel] support for containers |
Date: |
Tue, 29 Jan 2019 00:03:35 +0100 |
User-agent: |
mu4e 1.0; emacs 26.1 |
Hi,
the GWL could already support execution in containers with this patch:
--8<---------------cut here---------------start------------->8---
diff --git a/gwl/processes.scm b/gwl/processes.scm
index b7251db..9ec5925 100644
--- a/gwl/processes.scm
+++ b/gwl/processes.scm
@@ -19,13 +19,20 @@
#:use-module ((guix derivations)
#:select (derivation->output-path
build-derivations))
+ #:use-module ((guix packages)
+ #:select (package-file))
#:use-module (guix gexp)
- #:use-module ((guix monads) #:select (mlet return))
+ #:use-module ((guix monads) #:select (mlet mapm return))
#:use-module (guix records)
#:use-module ((guix store)
#:select (open-connection
run-with-store
+ with-store
%store-monad))
+ #:use-module ((guix modules)
+ #:select (source-module-closure))
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu build linux-container)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -232,34 +239,82 @@ of PROCESS."
(arguments code-snippet-arguments)
(code code-snippet-code))
-(define (procedure->gexp process)
+(define* (procedure->gexp process #:key (container? #t))
"Transform the procedure of PROCESS to a G-expression or return the
plain S-expression."
(define (sanitize-path path)
(string-join (delete ".." (string-split path #\/))
"/"))
- (match (process-procedure process)
- ((? gexp? g) g)
- ((? list? s) s)
- (($ <code-snippet> name arguments code)
- (let ((call (or (and=> (find (lambda (lang)
- (eq? name (language-name lang)))
- languages)
- language-call)
- ;; There is no pre-defined way to execute the
- ;; snippet. Use generic approach.
- (lambda (process code)
- #~(begin
- (for-each (lambda (pair)
- (setenv (car pair) (cdr pair)))
- '#$(process->env process))
- (apply system*
- (string-append (getenv "_GWL_PROFILE")
- #$(sanitize-path
(symbol->string name)))
- '#$(append arguments
- (list code))))))))
- (call process code)))
- (whatever (error (format #f "unsupported procedure: ~a\n" whatever)))))
+ (define contents
+ (match (process-procedure process)
+ ((? gexp? g) g)
+ ((? list? s) s)
+ (($ <code-snippet> name arguments code)
+ (let ((call (or (and=> (find (lambda (lang)
+ (eq? name (language-name lang)))
+ languages)
+ language-call)
+ ;; There is no pre-defined way to execute the
+ ;; snippet. Use generic approach.
+ (lambda (process code)
+ #~(begin
+ (for-each (lambda (pair)
+ (setenv (car pair) (cdr pair)))
+ '#$(process->env process))
+ (apply system*
+ (string-append (getenv "_GWL_PROFILE")
+ #$(sanitize-path
(symbol->string name)))
+ '#$(append arguments
+ (list code))))))))
+ (call process code)))
+ (whatever (error (format #f "unsupported procedure: ~a\n" whatever)))))
+
+ (if container?
+ (let* ((package-dirs
+ (with-store store
+ (run-with-store store
+ (mapm %store-monad package-file
+ (process-package-inputs process)))))
+ (data-input-dirs
+ (delete-duplicates
+ (map dirname (process-data-inputs process))))
+ (output-dirs
+ (delete-duplicates
+ (map dirname (process-outputs process))))
+ (input-mappings
+ (map (lambda (dir)
+ (file-system-mapping
+ (source dir)
+ (target dir)
+ (writable? #f)))
+ (lset-difference string=?
+ (append package-dirs
+ data-input-dirs)
+ output-dirs)))
+ (output-mappings
+ (map (lambda (dir)
+ (file-system-mapping
+ (source dir)
+ (target dir)
+ (writable? #t)))
+ output-dirs))
+ (specs
+ (map (compose file-system->spec
+ file-system-mapping->bind-mount)
+ (append input-mappings
+ output-mappings))))
+ (with-imported-modules (source-module-closure
+ '((gnu build linux-container)
+ (gnu system file-systems)))
+ #~(begin
+ (use-modules (gnu build linux-container)
+ (gnu system file-systems))
+ (call-with-container (append %container-file-systems
+ (map spec->file-system
+ '#$specs))
+ (lambda ()
+ #$contents)))))
+ contents))
;;; ---------------------------------------------------------------------------
;;; ADDITIONAL FUNCTIONS
--8<---------------cut here---------------end--------------->8---
The directories to be mounted in the container are derived from the
declared inputs and outputs. The only problem is that inputs are
read-only in this implementation. I like it this way, actually, but it
means that the extended example workflow won’t work as it tries to
delete its inputs.
Should data inputs be declared as (mutable-file …) or (file …) instead
of being plain strings?
--
Ricardo
- [gwl-devel] support for containers,
Ricardo Wurmus <=
- Re: [gwl-devel] support for containers, Ricardo Wurmus, 2019/01/29
- Re: [gwl-devel] support for containers, zimoun, 2019/01/29
- Re: [gwl-devel] support for containers, Ricardo Wurmus, 2019/01/29
- Re: [gwl-devel] support for containers, zimoun, 2019/01/29
- Re: [gwl-devel] support for containers, Ricardo Wurmus, 2019/01/30
- Re: [gwl-devel] support for containers, zimoun, 2019/01/29
- Re: [gwl-devel] support for containers, Ricardo Wurmus, 2019/01/29
- Re: [gwl-devel] support for containers, zimoun, 2019/01/30
- Re: [gwl-devel] support for containers, Ricardo Wurmus, 2019/01/30
Re: [gwl-devel] support for containers, zimoun, 2019/01/29