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:
parent
8f5825540d
commit
af15fe13b6
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue