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.
This commit is contained in:
Ludovic Courtès 2018-12-24 00:55:07 +01:00
parent 8f5825540d
commit af15fe13b6
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 27 additions and 9 deletions

View File

@ -54,6 +54,7 @@
#:use-module ((rnrs bytevectors) #:select (string->utf8)) #:use-module ((rnrs bytevectors) #:select (string->utf8))
#:export (inferior? #:export (inferior?
open-inferior open-inferior
port->inferior
close-inferior close-inferior
inferior-eval inferior-eval
inferior-eval-with-store inferior-eval-with-store
@ -93,10 +94,11 @@
;; Inferior Guix process. ;; Inferior Guix process.
(define-record-type <inferior> (define-record-type <inferior>
(inferior pid socket version packages table) (inferior pid socket close version packages table)
inferior? inferior?
(pid inferior-pid) (pid inferior-pid)
(socket inferior-socket) (socket inferior-socket)
(close inferior-close-socket) ;procedure
(version inferior-version) ;REPL protocol version (version inferior-version) ;REPL protocol version
(packages inferior-package-promise) ;promise of inferior packages (packages inferior-package-promise) ;promise of inferior packages
(table inferior-package-table)) ;promise of vhash (table inferior-package-table)) ;promise of vhash
@ -131,19 +133,17 @@ it's an old Guix."
((@ (guix scripts repl) machine-repl)))))) ((@ (guix scripts repl) machine-repl))))))
pipe))) pipe)))
(define* (open-inferior directory #:key (command "bin/guix")) (define* (port->inferior pipe #:optional (close close-port))
"Open the inferior Guix in DIRECTORY, running 'DIRECTORY/COMMAND repl' or "Given PIPE, an input/output port, return an inferior that talks over PIPE.
equivalent. Return #f if the inferior could not be launched." PIPE is closed with CLOSE when 'close-inferior' is called on the returned
(define pipe inferior."
(inferior-pipe directory command))
(cond-expand (cond-expand
((and guile-2 (not guile-2.2)) #t) ((and guile-2 (not guile-2.2)) #t)
(else (setvbuf pipe 'line))) (else (setvbuf pipe 'line)))
(match (read pipe) (match (read pipe)
(('repl-version 0 rest ...) (('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-packages result))
(delay (%inferior-package-table result))))) (delay (%inferior-package-table result)))))
(inferior-eval '(use-modules (guix)) result) (inferior-eval '(use-modules (guix)) result)
@ -155,9 +155,18 @@ equivalent. Return #f if the inferior could not be launched."
(_ (_
#f))) #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) (define (close-inferior inferior)
"Close 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. ;; Non-self-quoting object of the inferior.
(define-record-type <inferior-object> (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 ;; 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 ;; as its store. This ensures the inferior uses the same store, with the
;; same options, the same per-session GC roots, etc. ;; same options, the same per-session GC roots, etc.
;; FIXME: This strategy doesn't work for remote inferiors (SSH).
(call-with-temporary-directory (call-with-temporary-directory
(lambda (directory) (lambda (directory)
(chmod directory #o700) (chmod directory #o700)

View File

@ -18,6 +18,7 @@
(define-module (guix ssh) (define-module (guix ssh)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix inferior)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module ((guix utils) #:select (&fix-hint)) #:use-module ((guix utils) #:select (&fix-hint))
#:use-module (ssh session) #:use-module (ssh session)
@ -36,6 +37,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 binary-ports) #:use-module (ice-9 binary-ports)
#:export (open-ssh-session #:export (open-ssh-session
remote-inferior
remote-daemon-channel remote-daemon-channel
connect-to-remote-daemon connect-to-remote-daemon
send-files send-files
@ -94,6 +96,12 @@ Throw an error on failure."
(message (format #f (G_ "SSH connection to '~a' failed: ~a~%") (message (format #f (G_ "SSH connection to '~a' failed: ~a~%")
host (get-error session)))))))))) 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 (define* (remote-daemon-channel session
#:optional #:optional
(socket-name (socket-name