[bug#36162] [PATCH 0/4] Add 'remote-eval'

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Ludovic Courtès]

Hello Guix!

This patch series add ‘remote-eval’, which takes a gexp, remotely deploys
everything the gexp refers to, and evaluates it (see
<https://lists.gnu.org/archive/html/guix-devel/2019-03/msg00127.html> for
the initial discussion.)  So you can have gexps like:

  #~(execl #$(file-append ffmpeg "/bin/ffmpeg") …)

When you evaluate it, this specific ‘ffmpeg’ will be deployed over there.
Another example is:

  (with-imported-modules (source-module-closure '((gnu services herd)))
    #~(begin
        (use-modules (gnu services herd))
        (map live-service-provision (current-services))))

This gexp, when evaluated remotely, will use your very own (gnu services
herd) module and the corresponding Guile (so if you’re on Guile 3 and the
remote is still on Guile 2, that’s fine: Guile 3 will first be deployed
there.)

‘remote-eval’ allows you to build locally and send the build results,
or to send the derivations and build remotely.

The use case is for code that deals with state or has a side effect.
Otherwise you’d just use a derivation and offload it.

There are no tests for ‘remote-eval’ currently.  It would need a VM
with access to the store, as Jakob explained on guix-devel.

Thoughts?

Ludo’.

Ludovic Courtès (4):
  gexp: Add 'lower-gexp' and express 'gexp->derivation' in terms of it.
  Add (guix repl).
  inferior: Add 'read-repl-response'.
  Add (guix remote).

 Makefile.am           |   2 +
 guix/gexp.scm         | 238 +++++++++++++++++++++++++++++++-----------
 guix/inferior.scm     |   9 +-
 guix/remote.scm       | 130 +++++++++++++++++++++++
 guix/repl.scm         |  86 +++++++++++++++
 guix/scripts/repl.scm |  56 +---------
 tests/gexp.scm        |  37 +++++++
 7 files changed, 444 insertions(+), 114 deletions(-)
 create mode 100644 guix/remote.scm
 create mode 100644 guix/repl.scm

-- 
2.21.0

[bug#36162] [PATCH 1/4] gexp: Add 'lower-gexp' and express 'gexp->derivation' in terms of it.

[Ludovic Courtès]

* guix/gexp.scm (gexp-input-thing, gexp-input-output)
(gexp-input-native?): Export.
(lower-inputs): Return <gexp-input> records instead of tuples.
(lower-reference-graphs): Adjust accordingly.
(<lowered-gexp>): New record type.
(lower-gexp, gexp-input->tuple): New procedure.
(gexp->derivation)[%modules]: Remove.
[requested-graft?]: New variable.
[add-modules]: New procedure.
Rewrite in terms of 'lower-gexp'.
(gexp-inputs): Add TODO comment.
* tests/gexp.scm ("lower-gexp"): New test.
---
 guix/gexp.scm  | 238 +++++++++++++++++++++++++++++++++++++------------
 tests/gexp.scm |  37 ++++++++
 2 files changed, 216 insertions(+), 59 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 4f2adba90a..38f64db7f1 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -39,6 +39,9 @@
 
             gexp-input
             gexp-input?
+            gexp-input-thing
+            gexp-input-output
+            gexp-input-native?
 
             local-file
             local-file?
@@ -78,6 +81,14 @@
             load-path-expression
             gexp-modules
 
+            lower-gexp
+            lowered-gexp?
+            lowered-gexp-sexp
+            lowered-gexp-inputs
+            lowered-gexp-guile
+            lowered-gexp-load-path
+            lowered-gexp-load-compiled-path
+
             gexp->derivation
             gexp->file
             gexp->script
@@ -566,15 +577,20 @@ list."
   "Turn any package from INPUTS into a derivation for SYSTEM; return the
 corresponding input list as a monadic value.  When TARGET is true, use it as
 the cross-compilation target triplet."
+  (define (store-item? obj)
+    (and (string? obj) (store-path? obj)))
+
   (with-monad %store-monad
     (mapm %store-monad
           (match-lambda
             (((? struct? thing) sub-drv ...)
              (mlet %store-monad ((drv (lower-object
                                        thing system #:target target)))
-               (return `(,drv ,@sub-drv))))
+               (return (apply gexp-input drv sub-drv))))
+            (((? store-item? item))
+             (return (gexp-input item)))
             (input
-             (return input)))
+             (return (gexp-input input))))
           inputs)))
 
 (define* (lower-reference-graphs graphs #:key system target)
@@ -586,7 +602,9 @@ corresponding derivation."
      (mlet %store-monad ((inputs (lower-inputs inputs
                                                #:system system
                                                #:target target)))
-       (return (map cons file-names inputs))))))
+       (return (map (lambda (file input)
+                      (cons file (gexp-input->tuple input)))
+                    file-names inputs))))))
 
 (define* (lower-references lst #:key system target)
   "Based on LST, a list of output names and packages, return a list of output
@@ -618,6 +636,128 @@ names and file names suitable for the #:allowed-references argument to
     (lambda (system)
       ((force proc) system))))
 
+;; Representation of a gexp instantiated for a given target and system.
+(define-record-type <lowered-gexp>
+  (lowered-gexp sexp inputs guile load-path load-compiled-path)
+  lowered-gexp?
+  (sexp                lowered-gexp-sexp)         ;sexp
+  (inputs              lowered-gexp-inputs)       ;list of <gexp-input>
+  (guile               lowered-gexp-guile)        ;<derivation> | #f
+  (load-path           lowered-gexp-load-path)    ;list of store items
+  (load-compiled-path  lowered-gexp-load-compiled-path)) ;list of store items
+
+(define* (lower-gexp exp
+                     #:key
+                     (module-path %load-path)
+                     (system (%current-system))
+                     (target 'current)
+                     (graft? (%graft?))
+                     (guile-for-build (%guile-for-build))
+                     (effective-version "2.2")
+
+                     deprecation-warnings
+                     (pre-load-modules? #t))      ;transitional
+  "Lower EXP, a gexp, instantiating it for SYSTEM and TARGET.  Return a
+<lowered-gexp> ready to be used.
+
+Lowered gexps are an intermediate representation that's useful for
+applications that deal with gexps outside in a way that is disconnected from
+derivations--e.g., code evaluated for its side effects."
+  (define %modules
+    (delete-duplicates (gexp-modules exp)))
+
+  (define (search-path modules extensions suffix)
+    (append (match modules
+              ((? derivation? drv)
+               (list (derivation->output-path drv)))
+              (#f
+               '())
+              ((? store-path? item)
+               (list item)))
+            (map (lambda (extension)
+                   (string-append (match extension
+                                    ((? derivation? drv)
+                                     (derivation->output-path drv))
+                                    ((? store-path? item)
+                                     item))
+                                  suffix))
+                 extensions)))
+
+  (mlet* %store-monad ( ;; The following binding forces '%current-system' and
+                       ;; '%current-target-system' to be looked up at >>=
+                       ;; time.
+                       (graft?    (set-grafting graft?))
+
+                       (system -> (or system (%current-system)))
+                       (target -> (if (eq? target 'current)
+                                      (%current-target-system)
+                                      target))
+                       (guile     (if guile-for-build
+                                      (return guile-for-build)
+                                      (default-guile-derivation system)))
+                       (normals  (lower-inputs (gexp-inputs exp)
+                                               #:system system
+                                               #:target target))
+                       (natives  (lower-inputs (gexp-native-inputs exp)
+                                               #:system system
+                                               #:target #f))
+                       (inputs -> (append normals natives))
+                       (sexp     (gexp->sexp exp
+                                             #:system system
+                                             #:target target))
+                       (extensions -> (gexp-extensions exp))
+                       (exts     (mapm %store-monad
+                                       (lambda (obj)
+                                         (lower-object obj system))
+                                       extensions))
+                       (modules  (if (pair? %modules)
+                                     (imported-modules %modules
+                                                       #:system system
+                                                       #:module-path module-path)
+                                     (return #f)))
+                       (compiled (if (pair? %modules)
+                                     (compiled-modules %modules
+                                                       #:system system
+                                                       #:module-path module-path
+                                                       #:extensions extensions
+                                                       #:guile guile-for-build
+                                                       #:pre-load-modules?
+                                                       pre-load-modules?
+                                                       #:deprecation-warnings
+                                                       deprecation-warnings)
+                                     (return #f))))
+    (define load-path
+      (search-path modules exts
+                   (string-append "/share/guile/site/" effective-version)))
+
+    (define load-compiled-path
+      (search-path compiled exts
+                   (string-append "/lib/guile/" effective-version
+                                  "/site-ccache")))
+
+    (mbegin %store-monad
+      (set-grafting graft?)                       ;restore the initial setting
+      (return (lowered-gexp sexp
+                            `(,@(if modules
+                                    (list (gexp-input modules))
+                                    '())
+                              ,@(if compiled
+                                    (list (gexp-input compiled))
+                                    '())
+                              ,@(map gexp-input exts)
+                              ,@inputs)
+                            guile-for-build
+                            load-path
+                            load-compiled-path)))))
+
+(define (gexp-input->tuple input)
+  "Given INPUT, a <gexp-input> record, return the corresponding input tuple
+suitable for the 'derivation' procedure."
+  (match (gexp-input-output input)
+    ("out"  `(,(gexp-input-thing input)))
+    (output `(,(gexp-input-thing input)
+              ,(gexp-input-output input)))))
+
 (define* (gexp->derivation name exp
                            #:key
                            system (target 'current)
@@ -682,10 +822,8 @@ DEPRECATION-WARNINGS determines whether to show deprecation warnings while
 compiling modules.  It can be #f, #t, or 'detailed.
 
 The other arguments are as for 'derivation'."
-  (define %modules
-    (delete-duplicates
-     (append modules (gexp-modules exp))))
   (define outputs (gexp-outputs exp))
+  (define requested-graft? graft?)
 
   (define (graphs-file-names graphs)
     ;; Return a list of (FILE-NAME . STORE-PATH) pairs made from GRAPHS.
@@ -699,11 +837,13 @@ The other arguments are as for 'derivation'."
             (cons file-name thing)))
          graphs))
 
-  (define (extension-flags extension)
-    `("-L" ,(string-append (derivation->output-path extension)
-                           "/share/guile/site/" effective-version)
-      "-C" ,(string-append (derivation->output-path extension)
-                           "/lib/guile/" effective-version "/site-ccache")))
+  (define (add-modules exp modules)
+    (if (null? modules)
+        exp
+        (make-gexp (gexp-references exp)
+                   (append modules (gexp-self-modules exp))
+                   (gexp-self-extensions exp)
+                   (gexp-proc exp))))
 
   (mlet* %store-monad ( ;; The following binding forces '%current-system' and
                        ;; '%current-target-system' to be looked up at >>=
@@ -714,40 +854,21 @@ The other arguments are as for 'derivation'."
                        (target -> (if (eq? target 'current)
                                       (%current-target-system)
                                       target))
-                       (normals  (lower-inputs (gexp-inputs exp)
-                                               #:system system
-                                               #:target target))
-                       (natives  (lower-inputs (gexp-native-inputs exp)
-                                               #:system system
-                                               #:target #f))
-                       (inputs -> (append normals natives))
-                       (sexp     (gexp->sexp exp
-                                             #:system system
-                                             #:target target))
-                       (builder  (text-file script-name
-                                            (object->string sexp)))
-                       (extensions -> (gexp-extensions exp))
-                       (exts     (mapm %store-monad
-                                       (lambda (obj)
-                                         (lower-object obj system))
-                                       extensions))
-                       (modules  (if (pair? %modules)
-                                     (imported-modules %modules
-                                                       #:system system
-                                                       #:module-path module-path
-                                                       #:guile guile-for-build)
-                                     (return #f)))
-                       (compiled (if (pair? %modules)
-                                     (compiled-modules %modules
-                                                       #:system system
-                                                       #:module-path module-path
-                                                       #:extensions extensions
-                                                       #:guile guile-for-build
-                                                       #:pre-load-modules?
-                                                       pre-load-modules?
-                                                       #:deprecation-warnings
-                                                       deprecation-warnings)
-                                     (return #f)))
+                       (exp ->    (add-modules exp modules))
+                       (lowered   (lower-gexp exp
+                                              #:module-path module-path
+                                              #:system system
+                                              #:target target
+                                              #:graft? requested-graft?
+                                              #:guile-for-build
+                                              guile-for-build
+                                              #:effective-version
+                                              effective-version
+                                              #:deprecation-warnings
+                                              deprecation-warnings
+                                              #:pre-load-modules?
+                                              pre-load-modules?))
+
                        (graphs   (if references-graphs
                                      (lower-reference-graphs references-graphs
                                                              #:system system
@@ -763,32 +884,30 @@ The other arguments are as for 'derivation'."
                                                          #:system system
                                                          #:target target)
                                        (return #f)))
-                       (guile    (if guile-for-build
-                                     (return guile-for-build)
-                                     (default-guile-derivation system))))
+                       (guile -> (lowered-gexp-guile lowered))
+                       (builder  (text-file script-name
+                                            (object->string
+                                             (lowered-gexp-sexp lowered)))))
     (mbegin %store-monad
       (set-grafting graft?)                       ;restore the initial setting
       (raw-derivation name
                       (string-append (derivation->output-path guile)
                                      "/bin/guile")
                       `("--no-auto-compile"
-                        ,@(if (pair? %modules)
-                              `("-L" ,(if (derivation? modules)
-                                          (derivation->output-path modules)
-                                          modules)
-                                "-C" ,(derivation->output-path compiled))
-                              '())
-                        ,@(append-map extension-flags exts)
+                        ,@(append-map (lambda (directory)
+                                        `("-L" ,directory))
+                                      (lowered-gexp-load-path lowered))
+                        ,@(append-map (lambda (directory)
+                                        `("-C" ,directory))
+                                      (lowered-gexp-load-compiled-path lowered))
                         ,builder)
                       #:outputs outputs
                       #:env-vars env-vars
                       #:system system
                       #:inputs `((,guile)
                                  (,builder)
-                                 ,@(if modules
-                                       `((,modules) (,compiled) ,@inputs)
-                                       inputs)
-                                 ,@(map list exts)
+                                 ,@(map gexp-input->tuple
+                                        (lowered-gexp-inputs lowered))
                                  ,@(match graphs
                                      (((_ . inputs) ...) inputs)
                                      (_ '())))
@@ -804,6 +923,7 @@ The other arguments are as for 'derivation'."
 (define* (gexp-inputs exp #:key native?)
   "Return the input list for EXP.  When NATIVE? is true, return only native
 references; otherwise, return only non-native references."
+  ;; TODO: Return <gexp-input> records instead of tuples.
   (define (add-reference-inputs ref result)
     (match ref
       (($ <gexp-input> (? gexp? exp) _ #t)
diff --git a/tests/gexp.scm b/tests/gexp.scm
index cee2c96610..23904fce2e 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -832,6 +832,43 @@
       (built-derivations (list drv))
       (return (equal? '(42 84) (call-with-input-file out read))))))
 
+(test-assertm "lower-gexp"
+  (mlet* %store-monad
+      ((extension -> %extension-package)
+       (extension-drv (package->derivation %extension-package))
+       (coreutils-drv (package->derivation coreutils))
+       (exp ->   (with-extensions (list extension)
+                   (with-imported-modules `((guix build utils))
+                     #~(begin
+                         (use-modules (guix build utils)
+                                      (hg2g))
+                         #$coreutils:debug
+                         mkdir-p
+                         the-answer))))
+       (lexp     (lower-gexp exp
+                             #:effective-version "2.0")))
+    (define (matching-input drv output)
+      (lambda (input)
+        (and (eq? (gexp-input-thing input) drv)
+             (string=? (gexp-input-output input) output))))
+
+    (mbegin %store-monad
+      (return (and (find (matching-input extension-drv "out")
+                         (lowered-gexp-inputs (pk 'lexp lexp)))
+                   (find (matching-input coreutils-drv "debug")
+                         (lowered-gexp-inputs lexp))
+                   (member (string-append
+                            (derivation->output-path extension-drv)
+                            "/share/guile/site/2.0")
+                           (lowered-gexp-load-path lexp))
+                   (= 2 (length (lowered-gexp-load-path lexp)))
+                   (member (string-append
+                            (derivation->output-path extension-drv)
+                            "/lib/guile/2.0/site-ccache")
+                           (lowered-gexp-load-compiled-path lexp))
+                   (= 2 (length (lowered-gexp-load-compiled-path lexp)))
+                   (eq? (lowered-gexp-guile lexp) (%guile-for-build)))))))
+
 (test-assertm "gexp->derivation #:references-graphs"
   (mlet* %store-monad
       ((one (text-file "one" (random-text)))
-- 
2.21.0

[bug#36162] [PATCH 2/4] Add (guix repl).

[Ludovic Courtès]

* guix/scripts/repl.scm: Use (guix repl).
(self-quoting?, machine-repl): Remove.
* guix/repl.scm: New file.
* Makefile.am (MODULES): Add it.
---
 Makefile.am           |  1 +
 guix/repl.scm         | 86 +++++++++++++++++++++++++++++++++++++++++++
 guix/scripts/repl.scm | 56 ++--------------------------
 3 files changed, 90 insertions(+), 53 deletions(-)
 create mode 100644 guix/repl.scm

diff --git a/Makefile.am b/Makefile.am
index 80be73e4bf..0aa92ecfb9 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -90,6 +90,7 @@ MODULES =					\
   guix/nar.scm					\
   guix/derivations.scm				\
   guix/grafts.scm				\
+  guix/repl.scm					\
   guix/inferior.scm				\
   guix/describe.scm				\
   guix/channels.scm				\
diff --git a/guix/repl.scm b/guix/repl.scm
new file mode 100644
index 0000000000..5cff5c71e9
--- /dev/null
+++ b/guix/repl.scm
@@ -0,0 +1,86 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix repl)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 match)
+  #:export (send-repl-response
+            machine-repl))
+
+;;; Commentary:
+;;;
+;;; This module implements the "machine-readable" REPL provided by
+;;; 'guix repl -t machine'.  It's a lightweight module meant to be
+;;; embedded in any Guile process providing REPL functionality.
+;;;
+;;; Code:
+
+(define (self-quoting? x)
+  "Return #t if X is self-quoting."
+  (letrec-syntax ((one-of (syntax-rules ()
+                            ((_) #f)
+                            ((_ pred rest ...)
+                             (or (pred x)
+                                 (one-of rest ...))))))
+    (one-of symbol? string? pair? null? vector?
+            bytevector? number? boolean?)))
+
+
+(define (send-repl-response exp output)
+  "Write the response corresponding to the evaluation of EXP to PORT, an
+output port."
+  (define (value->sexp value)
+    (if (self-quoting? value)
+        `(value ,value)
+        `(non-self-quoting ,(object-address value)
+                           ,(object->string value))))
+
+  (catch #t
+    (lambda ()
+      (let ((results (call-with-values
+                         (lambda ()
+                           (primitive-eval exp))
+                       list)))
+        (write `(values ,@(map value->sexp results))
+               output)
+        (newline output)
+        (force-output output)))
+    (lambda (key . args)
+      (write `(exception ,key ,@(map value->sexp args)))
+      (newline output)
+      (force-output output))))
+
+(define* (machine-repl #:optional
+                       (input (current-input-port))
+                       (output (current-output-port)))
+  "Run a machine-usable REPL over ports INPUT and OUTPUT.
+
+The protocol of this REPL is meant to be machine-readable and provides proper
+support to represent multiple-value returns, exceptions, objects that lack a
+read syntax, and so on.  As such it is more convenient and robust than parsing
+Guile's REPL prompt."
+  (write `(repl-version 0 0) output)
+  (newline output)
+  (force-output output)
+
+  (let loop ()
+    (match (read input)
+      ((? eof-object?) #t)
+      (exp
+       (send-repl-response exp output)
+       (loop)))))
diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm
index 02169e8004..e1cc759fc8 100644
--- a/guix/scripts/repl.scm
+++ b/guix/scripts/repl.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +19,7 @@
 (define-module (guix scripts repl)
   #:use-module (guix ui)
   #:use-module (guix scripts)
+  #:use-module (guix repl)
   #:use-module (guix utils)
   #:use-module (guix packages)
   #:use-module (gnu packages)
@@ -29,8 +30,7 @@
   #:autoload   (system repl repl) (start-repl)
   #:autoload   (system repl server)
                   (make-tcp-server-socket make-unix-domain-server-socket)
-  #:export (machine-repl
-            guix-repl))
+  #:export (guix-repl))
 
 ;;; Commentary:
 ;;;
@@ -68,62 +68,12 @@ Start a Guile REPL in the Guix execution environment.\n"))
   (newline)
   (show-bug-report-information))
 
-(define (self-quoting? x)
-  "Return #t if X is self-quoting."
-  (letrec-syntax ((one-of (syntax-rules ()
-                            ((_) #f)
-                            ((_ pred rest ...)
-                             (or (pred x)
-                                 (one-of rest ...))))))
-    (one-of symbol? string? pair? null? vector?
-            bytevector? number? boolean?)))
-
 (define user-module
   ;; Module where we execute user code.
   (let ((module (resolve-module '(guix-user) #f #f #:ensure #t)))
     (beautify-user-module! module)
     module))
 
-(define* (machine-repl #:optional
-                       (input (current-input-port))
-                       (output (current-output-port)))
-  "Run a machine-usable REPL over ports INPUT and OUTPUT.
-
-The protocol of this REPL is meant to be machine-readable and provides proper
-support to represent multiple-value returns, exceptions, objects that lack a
-read syntax, and so on.  As such it is more convenient and robust than parsing
-Guile's REPL prompt."
-  (define (value->sexp value)
-    (if (self-quoting? value)
-        `(value ,value)
-        `(non-self-quoting ,(object-address value)
-                           ,(object->string value))))
-
-  (write `(repl-version 0 0) output)
-  (newline output)
-  (force-output output)
-
-  (let loop ()
-    (match (read input)
-      ((? eof-object?) #t)
-      (exp
-       (catch #t
-         (lambda ()
-           (let ((results (call-with-values
-                              (lambda ()
-
-                                (primitive-eval exp))
-                            list)))
-             (write `(values ,@(map value->sexp results))
-                    output)
-             (newline output)
-             (force-output output)))
-         (lambda (key . args)
-           (write `(exception ,key ,@(map value->sexp args)))
-           (newline output)
-           (force-output output)))
-       (loop)))))
-
 (define (call-with-connection spec thunk)
   "Dynamically-bind the current input and output ports according to SPEC and
 call THUNK."
-- 
2.21.0

[bug#36162] [PATCH 3/4] inferior: Add 'read-repl-response'.

[Ludovic Courtès]

* guix/inferior.scm (read-repl-response): New procedure.
(read-inferior-response): Use it.
---
 guix/inferior.scm | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 63c95141d7..fee97750b6 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -59,6 +59,7 @@
             inferior-eval
             inferior-eval-with-store
             inferior-object?
+            read-repl-response
 
             inferior-packages
             inferior-available-packages
@@ -183,7 +184,8 @@ equivalent.  Return #f if the inferior could not be launched."
 
 (set-record-type-printer! <inferior-object> write-inferior-object)
 
-(define (read-inferior-response inferior)
+(define (read-repl-response port)
+  "Read a (guix repl) response from PORT and return it as a Scheme object."
   (define sexp->object
     (match-lambda
       (('value value)
@@ -191,12 +193,15 @@ equivalent.  Return #f if the inferior could not be launched."
       (('non-self-quoting address string)
        (inferior-object address string))))
 
-  (match (read (inferior-socket inferior))
+  (match (read port)
     (('values objects ...)
      (apply values (map sexp->object objects)))
     (('exception key objects ...)
      (apply throw key (map sexp->object objects)))))
 
+(define (read-inferior-response inferior)
+  (read-repl-response (inferior-socket inferior)))
+
 (define (send-inferior-request exp inferior)
   (write exp (inferior-socket inferior))
   (newline (inferior-socket inferior)))
-- 
2.21.0

[bug#36162] [PATCH 4/4] Add (guix remote).

[Ludovic Courtès]

* guix/remote.scm: New file.
* Makefile.am (MODULES): Add it.
---
 Makefile.am     |   1 +
 guix/remote.scm | 130 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 131 insertions(+)
 create mode 100644 guix/remote.scm

diff --git a/Makefile.am b/Makefile.am
index 0aa92ecfb9..42307abaed 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -274,6 +274,7 @@ if HAVE_GUILE_SSH
 
 MODULES +=					\
   guix/ssh.scm					\
+  guix/remote.scm				\
   guix/scripts/copy.scm				\
   guix/store/ssh.scm
 
diff --git a/guix/remote.scm b/guix/remote.scm
new file mode 100644
index 0000000000..cc051dee8a
--- /dev/null
+++ b/guix/remote.scm
@@ -0,0 +1,130 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix remote)
+  #:use-module (guix ssh)
+  #:use-module (guix gexp)
+  #:use-module (guix inferior)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:use-module (guix modules)
+  #:use-module (guix derivations)
+  #:use-module (ssh popen)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:export (remote-eval))
+
+;;; Commentary:
+;;;
+;;; Evaluate a gexp on a remote machine, over SSH, ensuring that all the
+;;; elements the gexp refers to are deployed beforehand.  This is useful for
+;;; expressions that have side effects; for pure expressions, you would rather
+;;; build a derivation remotely or offload it.
+;;;
+;;; Code:
+
+(define (remote-pipe-for-gexp lowered session)
+  "Return a remote pipe for the given SESSION to evaluate LOWERED."
+  (define shell-quote
+    (compose object->string object->string))
+
+  (apply open-remote-pipe* session OPEN_READ
+         (string-append (derivation->output-path
+                         (lowered-gexp-guile lowered))
+                        "/bin/guile")
+         "--no-auto-compile"
+         (append (append-map (lambda (directory)
+                               `("-L" ,directory))
+                             (lowered-gexp-load-path lowered))
+                 (append-map (lambda (directory)
+                               `("-C" ,directory))
+                             (lowered-gexp-load-path lowered))
+                 `("-c"
+                   ,(shell-quote (lowered-gexp-sexp lowered))))))
+
+(define (%remote-eval lowered session)
+  "Evaluate LOWERED, a lowered gexp, in SESSION.  This assumes that all the
+prerequisites of EXP are already available on the host at SESSION."
+  (let* ((pipe   (remote-pipe-for-gexp lowered session))
+         (result (read-repl-response pipe)))
+    (close-port pipe)
+    result))
+
+(define (trampoline exp)
+  "Return a \"trampoline\" gexp that evaluates EXP and writes the evaluation
+result to the current output port using the (guix repl) protocol."
+  (define program
+    (scheme-file "remote-exp.scm" exp))
+
+  (with-imported-modules (source-module-closure '((guix repl)))
+    #~(begin
+        (use-modules (guix repl))
+        (send-repl-response '(primitive-load #$program)
+                            (current-output-port))
+        (force-output))))
+
+(define* (remote-eval exp session
+                      #:key
+                      (build-locally? #t)
+                      (module-path %load-path)
+                      (socket-name "/var/guix/daemon-socket/socket"))
+  "Evaluate EXP, a gexp, on the host at SESSION, an SSH session.  Ensure that
+all the elements EXP refers to are built and deployed to SESSION beforehand.
+When BUILD-LOCALLY? is true, said dependencies are built locally and sent to
+the remote store afterwards; otherwise, dependencies are built directly on the
+remote store."
+  (mlet %store-monad ((lowered (lower-gexp (trampoline exp)
+                                           #:module-path %load-path))
+                      (remote -> (connect-to-remote-daemon session
+                                                           socket-name)))
+    (define inputs
+      (cons (gexp-input (lowered-gexp-guile lowered))
+            (lowered-gexp-inputs lowered)))
+
+    (define to-build
+      (map (lambda (input)
+             (if (derivation? (gexp-input-thing input))
+                 (cons (gexp-input-thing input)
+                       (gexp-input-output input))
+                 (gexp-input-thing input)))
+           inputs))
+
+    (if build-locally?
+        (let ((to-send (map (lambda (input)
+                              (match (gexp-input-thing input)
+                                ((? derivation? drv)
+                                 (derivation->output-path
+                                  drv (gexp-input-output input)))
+                                ((? store-path? item)
+                                 item)))
+                            inputs)))
+          (mbegin %store-monad
+            (built-derivations to-build)
+            ((store-lift send-files) to-send remote #:recursive? #t)
+            (return (%remote-eval lowered session))))
+        (let ((to-send (map (lambda (input)
+                              (match (gexp-input-thing input)
+                                ((? derivation? drv)
+                                 (derivation-file-name drv))
+                                ((? store-path? item)
+                                 item)))
+                            inputs)))
+          (mbegin %store-monad
+            ((store-lift send-files) to-send remote #:recursive? #t)
+            (return (build-derivations remote to-build))
+            (return (%remote-eval lowered session)))))))
-- 
2.21.0

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Ricardo Wurmus]

Ludovic Courtès <ludo@gnu.org> writes:

> This patch series add ‘remote-eval’, which takes a gexp, remotely deploys
> everything the gexp refers to, and evaluates it (see
> <https://lists.gnu.org/archive/html/guix-devel/2019-03/msg00127.html> for
> the initial discussion.)  So you can have gexps like:
>
>   #~(execl #$(file-append ffmpeg "/bin/ffmpeg") …)
>
> When you evaluate it, this specific ‘ffmpeg’ will be deployed over there.
> Another example is:
>
>   (with-imported-modules (source-module-closure '((gnu services herd)))
>     #~(begin
>         (use-modules (gnu services herd))
>         (map live-service-provision (current-services))))

> This gexp, when evaluated remotely, will use your very own (gnu services
> herd) module and the corresponding Guile (so if you’re on Guile 3 and the
> remote is still on Guile 2, that’s fine: Guile 3 will first be deployed
> there.)
>
> ‘remote-eval’ allows you to build locally and send the build results,
> or to send the derivations and build remotely.

This is great and just what I need for the install-berlin.scm script in
the “maintenance” repository where I need to deploy a particular version
of Guix to the target system before using that version of Guix to
reconfigure the remote system.

Thank you!

--
Ricardo

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Jakob L. Kreuze]

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

zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) writes:

> Wow, this is great! It seems like this patch series is implementing a
> number of things I'd been wishing I could just import from some other
> Guix module. I'm signing off for the night, but I'll apply this tomorrow
> and give you some feedback.

It seems this breaks 'operating-system-derivation'.

#+BEGIN_SRC
Backtrace:
          19 (_ #<procedure 40d32e0 at ice-9/eval.scm:330:13 ()> #<…> …)
In gnu/services.scm:
    320:2 18 (_ _)
In gnu/system.scm:
    461:4 17 (_ _)
In unknown file:
          16 (_ #<procedure 40d9220 at ice-9/eval.scm:330:13 ()> #<…> …)
          15 (_ #<procedure 2ebc160 at ice-9/eval.scm:330:13 ()> #<…> …)
In guix/monads.scm:
    482:9 14 (_ _)
In unknown file:
          13 (_ #<procedure 2ebc100 at ice-9/eval.scm:330:13 ()> #<…> …)
In guix/store.scm:
   1667:8 12 (_ _)
   1667:8 11 (_ _)
In unknown file:
          10 (_ #<procedure 2f1d940 at ice-9/eval.scm:330:13 ()> #<…> …)
           9 (_ #<procedure 2f2c460 at ice-9/eval.scm:330:13 ()> #<…> …)
In guix/monads.scm:
    482:9  8 (_ _)
In unknown file:
           7 (_ #<procedure 26ba500 at ice-9/eval.scm:330:13 ()> #<…> …)
In guix/store.scm:
   1667:8  6 (_ _)
In unknown file:
           5 (_ #<procedure 2701740 at ice-9/eval.scm:330:13 ()> #<…> …)
           4 (_ #<procedure 27b2200 at ice-9/eval.scm:330:13 ()> #<…> …)
In ice-9/eval.scm:
   191:27  3 (_ #(#(#<directory (guix gexp) c8f640> #<procedure…>) …))
   173:47  2 (_ #(#(#<directory (guix gexp) c8f640> "module-im…" …) …))
    159:9  1 (_ #(#(#<directory (guix gexp) c8f640> "module-im…" …) …))
In guix/derivations.scm:
   597:28  0 (derivation->output-path #f _)

guix/derivations.scm:597:28: In procedure derivation->output-path:
In procedure struct_vtable: Wrong type argument in position 1 (expecting struct): #f
building gnu-deployed...
#+END_SRC

'git bisect' seems to think that 9dddee345b introduced it.

Regards,
Jakob

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Ludovic Courtès]

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

zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis:

> zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) writes:
>
>> Wow, this is great! It seems like this patch series is implementing a
>> number of things I'd been wishing I could just import from some other
>> Guix module. I'm signing off for the night, but I'll apply this tomorrow
>> and give you some feedback.
>
> It seems this breaks 'operating-system-derivation'.

[...]

> In guix/derivations.scm:
>    597:28  0 (derivation->output-path #f _)

Oops!  The patch below fixes it.

Let me know if you find other issues.  Thanks for testing!

Ludo’.


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

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 38f64db7f1..ab29c2494e 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -720,7 +720,7 @@ derivations--e.g., code evaluated for its side effects."
                                                        #:system system
                                                        #:module-path module-path
                                                        #:extensions extensions
-                                                       #:guile guile-for-build
+                                                       #:guile guile
                                                        #:pre-load-modules?
                                                        pre-load-modules?
                                                        #:deprecation-warnings
@@ -746,7 +746,7 @@ derivations--e.g., code evaluated for its side effects."
                                     '())
                               ,@(map gexp-input exts)
                               ,@inputs)
-                            guile-for-build
+                            guile
                             load-path
                             load-compiled-path)))))
 

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Jakob L. Kreuze]

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

Ludovic Courtès <ludo@gnu.org> writes:

> Let me know if you find other issues. Thanks for testing!

This fixes the test suite, but I'm having an issue with 'remote-eval'
now. A G-Expression with no inputs such as

#+BEGIN_SRC scheme
(mlet %store-monad ((result (remote-eval #~(begin (string-append "Hello, " "world!"))
                             (ssh-session machine))))
  (display result)
  (newline))
#+END_SRC

results in the following error:

#+BEGIN_SRC
Backtrace:
          13 (apply-smob/1 #<catch-closure 1954a20>)
In ice-9/boot-9.scm:
    705:2 12 (call-with-prompt _ _ #<procedure default-prompt-handle…>)
In ice-9/eval.scm:
    619:8 11 (_ #(#(#<directory (guile-user) 19d2140>)))
In guix/ui.scm:
  1747:12 10 (run-guix-command _ . _)
In guix/store.scm:
   623:10  9 (call-with-store _)
In srfi/srfi-1.scm:
    640:9  8 (for-each #<procedure 5fe5600 at guix/scripts/deploy.s…> …)
In guix/scripts/deploy.scm:
    84:20  7 (_ _)
In guix/store.scm:
  1794:24  6 (run-with-store _ _ #:guile-for-build _ #:system _ # _)
In unknown file:
           5 (_ #<procedure 5ff43c0 at ice-9/eval.scm:330:13 ()> #<…> …)
In guix/remote.scm:
   116:10  4 (_ _)
In guix/store.scm:
  1690:38  3 (_ #<store-connection 256.99 5da0960>)
In guix/derivations.scm:
   987:22  2 (build-derivations #<store-connection 256.99 5da0960> # _)
In srfi/srfi-1.scm:
   592:17  1 (map1 ((#<derivation /gnu/store/16c8c8hm1qdn6xz…> . #) …))
In guix/derivations.scm:
   987:27  0 (_ _)

guix/derivations.scm:987:27: Throw to key `match-error' with args `("match" "no matching pattern" (#<derivation /gnu/store/16c8c8hm1qdn6xz8014939mirc7c4d4j-guile-2.2.4.drv => /gnu/store/cz91c7nvg7495vacv44bxmqnn8sha3cb-guile-2.2.4-debug /gnu/store/r658y3cgpnf99nxjxqgjiaizx20ac4k0-guile-2.2.4 47e69b0> . "out"))'.
#+END_SRC

Regards,
Jakob

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Ludovic Courtès]

Hi,

zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis:

> In guix/derivations.scm:
>    987:22  2 (build-derivations #<store-connection 256.99 5da0960> # _)
> In srfi/srfi-1.scm:
>    592:17  1 (map1 ((#<derivation /gnu/store/16c8c8hm1qdn6xz…> . #) …))
> In guix/derivations.scm:
>    987:27  0 (_ _)
>
> guix/derivations.scm:987:27: Throw to key `match-error' with args `("match" "no matching pattern" (#<derivation /gnu/store/16c8c8hm1qdn6xz8014939mirc7c4d4j-guile-2.2.4.drv => /gnu/store/cz91c7nvg7495vacv44bxmqnn8sha3cb-guile-2.2.4-debug /gnu/store/r658y3cgpnf99nxjxqgjiaizx20ac4k0-guile-2.2.4 47e69b0> . "out"))'.

I think that’s because you’re on an older Guix, which lacks commit
f8a9f99cd602ce1dc5307cb0c21ae718ad8796bb.

HTH!

Ludo’.

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Jakob L. Kreuze]

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

Ludovic Courtès <ludo@gnu.org> writes:

> I think that’s because you’re on an older Guix, which lacks commit
> f8a9f99cd602ce1dc5307cb0c21ae718ad8796bb.

Guess I let my feature branch go a little stale. Fetched from upstream
and it works now :)  I'll have a go at reimplementing 'deploy-os' and
let you know if I run into any other issues.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Jakob L. Kreuze]

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

zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) writes:

> Guess I let my feature branch go a little stale. Fetched from upstream
> and it works now :) I'll have a go at reimplementing 'deploy-os' and
> let you know if I run into any other issues.

Works like a charm! There's more code for me to clean up, but we've got
a preliminary reimplementation of 'deploy-os' using your 'remote-eval'.
Pushed it to my personal branch if you'd like to take a look.

  https://git.sr.ht/~jakob/guix/commit/ca8e7b77cef4a60e9d820d6ae05b8b59f64b4f23

Thanks again for implementing this!

Regards,
Jakob

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Ludovic Courtès]

Hi Jakob,

zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis:

> zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) writes:
>
>> Guess I let my feature branch go a little stale. Fetched from upstream
>> and it works now :) I'll have a go at reimplementing 'deploy-os' and
>> let you know if I run into any other issues.
>
> Works like a charm! There's more code for me to clean up, but we've got
> a preliminary reimplementation of 'deploy-os' using your 'remote-eval'.
> Pushed it to my personal branch if you'd like to take a look.
>
>   https://git.sr.ht/~jakob/guix/commit/ca8e7b77cef4a60e9d820d6ae05b8b59f64b4f23

Woow, that was fast!  It looks good, and the patch removes a few lines
of code, which is always nice.  :-)

I’ll push the ‘remote-eval’ things shortly.  There’s certainly a few
things we can improve, and one of them is progress report: there’s
currently no call to ‘show-what-to-build’, and that’s obviously not
great.

Thank you for the great feedback!

Ludo’.

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Christopher Lemmer Webber]

Ludovic Courtès writes:

> I’ll push the ‘remote-eval’ things shortly.  There’s certainly a few
> things we can improve, and one of them is progress report: there’s
> currently no call to ‘show-what-to-build’, and that’s obviously not
> great.

Hi Ludo'!

It looks like Jakob's code is nearing the point where we can merge it
into Guix proper.  I'd like to get in the "guix deploy" stuff as soon as
it's good enough to merge.  Would you mind pushing up your remote-eval
stuff, if you're confident enough to do so, since it's a preliminary
requirement for "guix deploy"?

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Ludovic Courtès]

Hello!

Christopher Lemmer Webber <cwebber@dustycloud.org> skribis:

> It looks like Jakob's code is nearing the point where we can merge it
> into Guix proper.  I'd like to get in the "guix deploy" stuff as soon as
> it's good enough to merge.  Would you mind pushing up your remote-eval
> stuff, if you're confident enough to do so, since it's a preliminary
> requirement for "guix deploy"?

I finally went ahead and pushed it, after adding a note about the
instability of the API.  :-)

I think ‘remote-eval’ shouldn’t change much, but I’m not fully satisfied
with ‘lower-gexp’ in that it’s a bit too redundant with <derivation>
etc.  I couldn’t turn that vague feeling into actual code changes
though, so I’ll keep looking at it in the background, and it shouldn’t
have any impact on how ‘guix deploy’ uses ‘remote-eval’.

Apologies for the delay!

Ludo’.

Progress on 'guix deploy'

[Jakob L. Kreuze]

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

Hello, Guix!

Apart from a few patches and my introductory email about a month ago,
I've been pretty silent. I feel it's time to finally break that silence,
let people know where progress has been made, and request some feedback
on the code I've written so far.

As a quick refresher, my GSoC project this summer is 'guix deploy', a
deployment automation tool for GuixSD that's been discussed more
thoroughly in [1] and [2]. Development has taken place on my personal
branch of Guix, specifically the 'wip-deploy' branch [3], and is
represented by three new Scheme source files:

- 'gnu/machine.scm', which provides an abstraction for /something/ that
  can be deployed to in a heterogeneous deployment. Currently, the only
  concrete implementation of this is the simple case of in-place updates
  to machines running SSH whose names and IP addresses we know.
- 'gnu/tests/machine.scm', which implements some tests for
  'gnu/machine.scm'. This is where I'm most interested in receiving
  feedback. More on that later.
- 'guix/scripts/deploy.scm', which implements the rudimentary
  command-line interface for 'guix deploy'.

The command-line interface hasn't really been fleshed out yet, but if
you'd like to play around with it, it takes a "deployment" file as a
parameter, which is a Scheme file looking something like the following:

#+BEGIN_SRC scheme
(use-modules ...)

(define %system
  (operating-system
   (host-name "gnu-deployed")
   (timezone "Etc/UTC")
   (bootloader (bootloader-configuration
                (bootloader grub-bootloader)
                (target "/dev/sda")
                (terminal-outputs '(console))))
   (file-systems (cons (file-system
                        (mount-point "/")
                        (device "/dev/vda1")
                        (type "ext4"))
                       %base-file-systems))
   (services
    (append (list (service dhcp-client-service-type)
                  (service openssh-service-type
                           (openssh-configuration
                            (permit-root-login #t)
                            (allow-empty-passwords? #t))))
            %base-services))))

(list (make <sshable-machine>
        #:host-name "localhost"
        #:ssh-port 5556
        #:system %system))
#+END_SRC

Basically, you attach an 'operating-system' declaration to a 'machine'.
In this case, 'sshable-machine' is the specific type of 'machine' that
we're deploying to (one that's running an SSH daemon and has a known IP
+ port + hostname).

I've found that the GuixSD QEMU images work well for playing around with
this, provided that you add the SSH service to the system configuration
and start it. In the case of this deployment file, I had a GuixSD guest
with port 22 forwarded to my host's port 5556. You'll also need to set
up some sort of public key auth in your SSH config. The current code
isn't capable of handling other forms of SSH authentication.

In terms of implementation, GOOPS feels like a bit of an unusual choice
when juxtaposed with the rest of the Guix codebase, but I've come to
really enjoy it. I'll roll with it for now, since I think it will make
it easier to flesh out the vocabulary for specifying deployments.

The implementation of '<sshable-machine>' is doing what
'switch-to-system' and 'install-bootloader' in 'guix/scripts/system.scm'
do, but in terms of data that can be sent with 'remote-eval'. I imagine
the code will make more sense if you read both simultaneously.

Okay, on to the test suite.

My understanding of the system test suite (tests run with 'check-system'
as opposed to those run with 'check') is that the meat of the test code
exists in a G-Expression and should _not_ be interacting with the store
of the machine running the test suite (i.e. that's the reason we're
using marionettes in the first place). 'gnu/tests/install.scm' seems to
be somewhat of an exception, and because the code in '(gnu machine)'
depends heavily on having access to a store, I've tried to extend what's
done in 'gnu/tests/install.scm' so that my tests have access to store
while instrumenting the marionettes.

To be specific, the chicken and egg scenario I'm working around is that
the SSH daemon on the marionette needs to be running in order for
'deploy-os' to work, but I can't call 'deploy-os' from the test
G-Expression because the store wouldn't be accessible then.

My gut is telling me that this is absolutely the wrong way to go about
it, though. 'call-with-marionette' is one of a couple red flags making
me feel that way -- I don't think marionettes were meant to be started
outside the context of a derivation...

If anyone has suggestions on how I might go about properly testing this
code, I would appreciate it very much.

Another point about the test suite: the 'ssh-deploy-os' test fails, but
it's a reproducible version of the issue outlined in [2]. I'd like to
conscript some help from those more familiar with guile-ssh before
breaking out the ol' RFCs myself.

...

So, if anyone's in the mood to peek at what's been written so far and
give feedback, that'd make my day. Doesn't have to be feedback related
to the test code, either. Any sort of comment, be it regarding the code
style or perhaps even some suggestions on improving the interface, would
be appreciated.

I'm going to continue to spend time on the "internals" of 'guix deploy'
this coming week, incorporating any feedback I receive and ensuring that
I have a framework to build upon when I extend this to more complicated
scenarios like deploying to a VPS provider. After that, I'll tackle
fleshing out the way deployments are specified (the file part. I'm
holding off on the command-line tool part for right now).

Signing off for now. Huge thanks to everyone for the warm welcome I
received following my introduction email.

Regards,
Jakob

[1]: https://lists.gnu.org/archive/html/guix-devel/2019-02/msg00145.html
[2]: https://lists.gnu.org/archive/html/guix-devel/2019-03/msg00114.html
[3]: https://git.sr.ht/~jakob/guix/tree/wip-deploy

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

Re: Progress on 'guix deploy'

[Ludovic Courtès]

Hello Jakob,

zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis:

> As a quick refresher, my GSoC project this summer is 'guix deploy', a
> deployment automation tool for GuixSD that's been discussed more
> thoroughly in [1] and [2]. Development has taken place on my personal
> branch of Guix, specifically the 'wip-deploy' branch [3], and is
> represented by three new Scheme source files:
>
> - 'gnu/machine.scm', which provides an abstraction for /something/ that
>   can be deployed to in a heterogeneous deployment. Currently, the only
>   concrete implementation of this is the simple case of in-place updates
>   to machines running SSH whose names and IP addresses we know.
> - 'gnu/tests/machine.scm', which implements some tests for
>   'gnu/machine.scm'. This is where I'm most interested in receiving
>   feedback. More on that later.
> - 'guix/scripts/deploy.scm', which implements the rudimentary
>   command-line interface for 'guix deploy'.

Nice!

> The command-line interface hasn't really been fleshed out yet, but if
> you'd like to play around with it, it takes a "deployment" file as a
> parameter, which is a Scheme file looking something like the following:
>
> #+BEGIN_SRC scheme
> (use-modules ...)
>
> (define %system
>   (operating-system
>    (host-name "gnu-deployed")
>    (timezone "Etc/UTC")
>    (bootloader (bootloader-configuration
>                 (bootloader grub-bootloader)
>                 (target "/dev/sda")
>                 (terminal-outputs '(console))))
>    (file-systems (cons (file-system
>                         (mount-point "/")
>                         (device "/dev/vda1")
>                         (type "ext4"))
>                        %base-file-systems))
>    (services
>     (append (list (service dhcp-client-service-type)
>                   (service openssh-service-type
>                            (openssh-configuration
>                             (permit-root-login #t)
>                             (allow-empty-passwords? #t))))
>             %base-services))))
>
> (list (make <sshable-machine>
>         #:host-name "localhost"
>         #:ssh-port 5556
>         #:system %system))
> #+END_SRC
>
> Basically, you attach an 'operating-system' declaration to a 'machine'.
> In this case, 'sshable-machine' is the specific type of 'machine' that
> we're deploying to (one that's running an SSH daemon and has a known IP
> + port + hostname).

Looks great to me.

> I've found that the GuixSD QEMU images work well for playing around with
> this, provided that you add the SSH service to the system configuration
> and start it. In the case of this deployment file, I had a GuixSD guest
> with port 22 forwarded to my host's port 5556. You'll also need to set
> up some sort of public key auth in your SSH config. The current code
> isn't capable of handling other forms of SSH authentication.

That’s reasonable.

> In terms of implementation, GOOPS feels like a bit of an unusual choice
> when juxtaposed with the rest of the Guix codebase, but I've come to
> really enjoy it. I'll roll with it for now, since I think it will make
> it easier to flesh out the vocabulary for specifying deployments.

It’s more than unusual.  :-)  Perhaps it’s the right choice here, we’ll
have to discuss it at some point!

> The implementation of '<sshable-machine>' is doing what
> 'switch-to-system' and 'install-bootloader' in 'guix/scripts/system.scm'
> do, but in terms of data that can be sent with 'remote-eval'. I imagine
> the code will make more sense if you read both simultaneously.

OK, sounds good.

Some time ago, I proposed to have ‘remove-eval’ where you could do:

  (remote-eval #~(begin …) #:session …)

which would take care of building and copying everything the gexp refers
to (see
<https://lists.gnu.org/archive/html/guix-devel/2019-03/msg00127.html>.)
That would generalize a bit what you describe above.  But anyway, that’s
something that can always come later.

> Okay, on to the test suite.
>
> My understanding of the system test suite (tests run with 'check-system'
> as opposed to those run with 'check') is that the meat of the test code
> exists in a G-Expression and should _not_ be interacting with the store
> of the machine running the test suite (i.e. that's the reason we're
> using marionettes in the first place). 'gnu/tests/install.scm' seems to
> be somewhat of an exception, and because the code in '(gnu machine)'
> depends heavily on having access to a store, I've tried to extend what's
> done in 'gnu/tests/install.scm' so that my tests have access to store
> while instrumenting the marionettes.

When you say “access the store”, you mean interact with the build
daemon, right?

The (gnu tests install) tests are indeed the only ones that talk to the
build daemon.

> To be specific, the chicken and egg scenario I'm working around is that
> the SSH daemon on the marionette needs to be running in order for
> 'deploy-os' to work, but I can't call 'deploy-os' from the test
> G-Expression because the store wouldn't be accessible then.
>
> My gut is telling me that this is absolutely the wrong way to go about
> it, though. 'call-with-marionette' is one of a couple red flags making
> me feel that way -- I don't think marionettes were meant to be started
> outside the context of a derivation...

Marionettes are just a way to instrument the system under test, which is
running in a VM.

I think what you need is to ensure the target VM (the one you’re
deploying to) has a writable store.  To do that, you could create the
target VM with the equivalent of ‘guix system vm-image’, which is the
‘system-qemu-image’ procedure.  (That will require a bit of disk space,
because that image needs to be large enough to hold the store of the
machine.)

How does that sound?

> I'm going to continue to spend time on the "internals" of 'guix deploy'
> this coming week, incorporating any feedback I receive and ensuring that
> I have a framework to build upon when I extend this to more complicated
> scenarios like deploying to a VPS provider. After that, I'll tackle
> fleshing out the way deployments are specified (the file part. I'm
> holding off on the command-line tool part for right now).

Sounds good!

Consider hanging out on #guix and sending email here—it’s usually easier
to get feedback on specific topics.

Anyway, glad to see so much progress already!  Thanks for the update!

Ludo’.

Re: Progress on 'guix deploy'

[Jakob L. Kreuze]

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

Ludovic Courtès <ludo@gnu.org> writes:

> OK, sounds good.
>
> Some time ago, I proposed to have ‘remove-eval’ where you could do:
>
>   (remote-eval #~(begin …) #:session …)
>
> which would take care of building and copying everything the gexp
> refers to (see
> <https://lists.gnu.org/archive/html/guix-devel/2019-03/msg00127.html>.)
> That would generalize a bit what you describe above. But anyway,
> that’s something that can always come later.

My focus for the next few days is going to be on cleaning up the
implementation of the internals, so I'll look into that. Gaining some
knowledge of how G-Expressions work would probably serve me well in
improving my kludge of a test suite anway ;)  But I think you're right
that it wouldn't be too difficult to deal with later on.

> Marionettes are just a way to instrument the system under test, which
> is running in a VM.
>
> I think what you need is to ensure the target VM (the one you’re
> deploying to) has a writable store. To do that, you could create the
> target VM with the equivalent of ‘guix system vm-image’, which is the
> ‘system-qemu-image’ procedure. (That will require a bit of disk space,
> because that image needs to be large enough to hold the store of the
> machine.)
>
> How does that sound?

Sounds like I've got some code to read :)

It seems likely that the SSH issue I was dealing was being caused by the
store being read-only. I'll investigate that today and report back.

> Consider hanging out on #guix and sending email here—it’s usually easier to get
> feedback on specific topics.
>
> Anyway, glad to see so much progress already! Thanks for the update!

Will do!

Regards,
Jakob

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Jakob L. Kreuze]

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

Wow, this is great! It seems like this patch series is implementing a
number of things I'd been wishing I could just import from some other
Guix module. I'm signing off for the night, but I'll apply this tomorrow
and give you some feedback.

Ludovic Courtès <ludo@gnu.org> writes:

> There are no tests for ‘remote-eval’ currently.  It would need a VM
> with access to the store, as Jakob explained on guix-devel.

One idea I had in developing my test suite was to design another record
type to supplement '<system-test>' for tests that /do/ need access the
host's store as they're running, but thought it would be too intrusive
as it would only be used by the tests for '(gnu machine)'. Now that we
have a ‘remote-eval’ that would benefit from being tested that way,
though, I'd like to ask: is that something I should look into?

Thanks again for implementing this

Jakob

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Ludovic Courtès]

Hello,

zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis:

> One idea I had in developing my test suite was to design another record
> type to supplement '<system-test>' for tests that /do/ need access the
> host's store as they're running, but thought it would be too intrusive
> as it would only be used by the tests for '(gnu machine)'. Now that we
> have a ‘remote-eval’ that would benefit from being tested that way,
> though, I'd like to ask: is that something I should look into?

Tests are supposed to be deterministic, so as such, it makes sense for
tests to be normal derivations, as is currently the case.

In that spirit, we should instead tweak <virtual-machine> so that we can
instruct it to build an autonomous VM with its own store.

OTOH, we could also have ‘container-eval’, similar to ‘remote-eval’,
which would be useful for effectful code, such as code that needs to
interact with the daemon.  Food for thought!

Thanks,
Ludo’.

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Jakob L. Kreuze]

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

Ludovic Courtès <ludo@gnu.org> writes:

> Tests are supposed to be deterministic, so as such, it makes sense for
> tests to be normal derivations, as is currently the case.

Makes sense. I actually hadn't realized that the Guix test suite (those
run with 'check' rather than 'check-system') were also derivations until
you mentioned it. It seems like looking at the implementation there
would give me a better idea of how to structure my tests.

> In that spirit, we should instead tweak <virtual-machine> so that we
> can instruct it to build an autonomous VM with its own store.

I like that idea. There's a 'system-qemu-image/shared-store-script', but
no 'system-qemu-image-script', so I'll have to take what I did for my
test suite experiments and turn it into something proper.

> OTOH, we could also have ‘container-eval’, similar to ‘remote-eval’,
> which would be useful for effectful code, such as code that needs to
> interact with the daemon. Food for thought!

'container' in the sense of 'guix environment' containers?

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#36162] [PATCH 0/4] Add 'remote-eval'

[Ludovic Courtès]

zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) skribis:

> Ludovic Courtès <ludo@gnu.org> writes:

[...]

>> OTOH, we could also have ‘container-eval’, similar to ‘remote-eval’,
>> which would be useful for effectful code, such as code that needs to
>> interact with the daemon. Food for thought!
>
> 'container' in the sense of 'guix environment' containers?

Yes, but more generally in the sense of a process running in separate
namespaces.

Ludo’.