01/04: ssh: Add 'remote-inferior'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit af15fe13b69d27f9902353540fd8ad0001ce8311
Author: Ludovic Courtès <address@hidden>
Date:   Mon Dec 24 00:55:07 2018 +0100

    ssh: Add 'remote-inferior'.
    
    * guix/inferior.scm (<inferior>)[close]: New field.
    (port->inferior): New procedure.
    (open-inferior): Rewrite in terms of 'port->inferior'.
    (close-inferior): Honor INFERIOR's 'close' field.
    (inferior-eval-with-store): Add FIXME comment.
    * guix/ssh.scm (remote-inferior): New procedure.
---
 guix/inferior.scm | 28 +++++++++++++++++++---------
 guix/ssh.scm      |  8 ++++++++
 2 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index ccc1c27..973bd52 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -54,6 +54,7 @@
   #:use-module ((rnrs bytevectors) #:select (string->utf8))
   #:export (inferior?
             open-inferior
+            port->inferior
             close-inferior
             inferior-eval
             inferior-eval-with-store
@@ -93,10 +94,11 @@
 
 ;; Inferior Guix process.
 (define-record-type <inferior>
-  (inferior pid socket version packages table)
+  (inferior pid socket close version packages table)
   inferior?
   (pid      inferior-pid)
   (socket   inferior-socket)
+  (close    inferior-close-socket)               ;procedure
   (version  inferior-version)                    ;REPL protocol version
   (packages inferior-package-promise)            ;promise of inferior packages
   (table    inferior-package-table))             ;promise of vhash
@@ -131,19 +133,17 @@ it's an old Guix."
                           ((@ (guix scripts repl) machine-repl))))))
         pipe)))
 
-(define* (open-inferior directory #:key (command "bin/guix"))
-  "Open the inferior Guix in DIRECTORY, running 'DIRECTORY/COMMAND repl' or
-equivalent.  Return #f if the inferior could not be launched."
-  (define pipe
-    (inferior-pipe directory command))
-
+(define* (port->inferior pipe #:optional (close close-port))
+  "Given PIPE, an input/output port, return an inferior that talks over PIPE.
+PIPE is closed with CLOSE when 'close-inferior' is called on the returned
+inferior."
   (cond-expand
     ((and guile-2 (not guile-2.2)) #t)
     (else (setvbuf pipe 'line)))
 
   (match (read pipe)
     (('repl-version 0 rest ...)
-     (letrec ((result (inferior 'pipe pipe (cons 0 rest)
+     (letrec ((result (inferior 'pipe pipe close (cons 0 rest)
                                 (delay (%inferior-packages result))
                                 (delay (%inferior-package-table result)))))
        (inferior-eval '(use-modules (guix)) result)
@@ -155,9 +155,18 @@ equivalent.  Return #f if the inferior could not be 
launched."
     (_
      #f)))
 
+(define* (open-inferior directory #:key (command "bin/guix"))
+  "Open the inferior Guix in DIRECTORY, running 'DIRECTORY/COMMAND repl' or
+equivalent.  Return #f if the inferior could not be launched."
+  (define pipe
+    (inferior-pipe directory command))
+
+  (port->inferior pipe close-pipe))
+
 (define (close-inferior inferior)
   "Close INFERIOR."
-  (close-pipe (inferior-socket inferior)))
+  (let ((close (inferior-close-socket inferior)))
+    (close (inferior-socket inferior))))
 
 ;; Non-self-quoting object of the inferior.
 (define-record-type <inferior-object>
@@ -409,6 +418,7 @@ thus be the code of a one-argument procedure that accepts a 
store."
   ;; Create a named socket in /tmp and let INFERIOR connect to it and use it
   ;; as its store.  This ensures the inferior uses the same store, with the
   ;; same options, the same per-session GC roots, etc.
+  ;; FIXME: This strategy doesn't work for remote inferiors (SSH).
   (call-with-temporary-directory
    (lambda (directory)
      (chmod directory #o700)
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 104f4f5..b8bea80 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -18,6 +18,7 @@
 
 (define-module (guix ssh)
   #:use-module (guix store)
+  #:use-module (guix inferior)
   #:use-module (guix i18n)
   #:use-module ((guix utils) #:select (&fix-hint))
   #:use-module (ssh session)
@@ -36,6 +37,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 binary-ports)
   #:export (open-ssh-session
+            remote-inferior
             remote-daemon-channel
             connect-to-remote-daemon
             send-files
@@ -94,6 +96,12 @@ Throw an error on failure."
                 (message (format #f (G_ "SSH connection to '~a' failed: ~a~%")
                                  host (get-error session))))))))))
 
+(define (remote-inferior session)
+  "Return a remote inferior for the given SESSION."
+  (let ((pipe (open-remote-pipe* session OPEN_BOTH
+                                 "guix" "repl" "-t" "machine")))
+    (port->inferior pipe)))
+
 (define* (remote-daemon-channel session
                                 #:optional
                                 (socket-name