From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from list by lists.gnu.org with archive (Exim 4.71) id 1goFwe-0006lN-Qa for mharc-gwl-devel@gnu.org; Mon, 28 Jan 2019 18:04:00 -0500 Received: from eggs.gnu.org ([209.51.188.92]:53287) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1goFwb-0006gk-BS for gwl-devel@gnu.org; Mon, 28 Jan 2019 18:03:59 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1goFwZ-0007xC-EY for gwl-devel@gnu.org; Mon, 28 Jan 2019 18:03:57 -0500 Received: from sender-of-o51.zoho.com ([135.84.80.216]:21037) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1goFwX-0007oV-M8 for gwl-devel@gnu.org; Mon, 28 Jan 2019 18:03:55 -0500 From: Ricardo Wurmus Date: Tue, 29 Jan 2019 00:03:35 +0100 Message-ID: <87bm40qta0.fsf@elephly.net> MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Subject: support for containers List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , To: gwl-devel@gnu.org 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) - (($ name arguments code) - (let ((call (or (and=3D> (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) + (($ name arguments code) + (let ((call (or (and=3D> (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 (symbo= l->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=3D? + (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=E2=80=99t work as it tries to delete its inputs. Should data inputs be declared as (mutable-file =E2=80=A6) or (file =E2=80= =A6) instead of being plain strings? -- Ricardo