[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/04: Add (guix ssh) module.
|
From: |
Ludovic Courtès |
|
Subject: |
01/04: Add (guix ssh) module. |
|
Date: |
Sat, 31 Dec 2016 00:46:47 +0000 (UTC) |
civodul pushed a commit to branch master
in repository guix.
commit 987a29ba43cc8a2751eafe392906d240713c724e
Author: Ludovic Courtès <address@hidden>
Date: Fri Dec 30 23:22:27 2016 +0100
Add (guix ssh) module.
* guix/scripts/offload.scm (connect-to-remote-daemon)
(store-import-channel, store-export-channel, send-files)
(retrieve-files): Move to (guix ssh).
(nonce): Add optional 'name' parameter and use it.
(retrieve-files*): New procedure.
(transfer-and-offload): Use it instead of 'retrieve-files', and add
first parameter to 'send-files'.
(assert-node-can-import): Likewise.
(assert-node-can-export): Use 'retrieve-files' instead of
'store-export-channel'.
* guix/ssh.scm: New file.
* configure.ac: Use 'GUIX_CHECK_GUILE_SSH' and define 'HAVE_GUILE_SSH'
Automake conditional.
* Makefile.am (MODULES) [HAVE_GUILE_SSH]: Add guix/ssh.scm.
---
Makefile.am | 7 ++
configure.ac | 5 ++
guix/scripts/offload.scm | 154 ++++------------------------------
guix/ssh.scm | 204 ++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 233 insertions(+), 137 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index 97629f2..094d6e5 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -170,6 +170,13 @@ MODULES += \
endif
+if HAVE_GUILE_SSH
+
+MODULES += \
+ guix/ssh.scm
+
+endif HAVE_GUILE_SSH
+
if BUILD_DAEMON_OFFLOAD
MODULES += \
diff --git a/configure.ac b/configure.ac
index c3173d6..676f600 100644
--- a/configure.ac
+++ b/configure.ac
@@ -216,6 +216,11 @@ AC_MSG_CHECKING([for zlib's shared library name])
AC_MSG_RESULT([$LIBZ])
AC_SUBST([LIBZ])
+dnl Check for Guile-SSH, for the (guix ssh) module.
+GUIX_CHECK_GUILE_SSH
+AM_CONDITIONAL([HAVE_GUILE_SSH],
+ [test "x$guix_cv_have_recent_guile_ssh" = "xyes"])
+
AC_CACHE_SAVE
m4_include([config-daemon.ac])
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index c98cf8c..6a4ae28 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -27,6 +27,7 @@
#:use-module (ssh version)
#:use-module (guix config)
#:use-module (guix records)
+ #:use-module (guix ssh)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module ((guix serialization)
@@ -221,53 +222,6 @@ instead of '~a' of type '~a'~%")
(leave (_ "failed to connect to '~a': ~a~%")
(build-machine-name machine) (get-error session))))))
-(define* (connect-to-remote-daemon session
- #:optional
- (socket-name
"/var/guix/daemon-socket/socket"))
- "Connect to the remote build daemon listening on SOCKET-NAME over SESSION,
-an SSH session. Return a <nix-server> object."
- (define redirect
- ;; Code run in SESSION to redirect the remote process' stdin/stdout to the
- ;; daemon's socket, Ã la socat. The SSH protocol supports forwarding to
- ;; Unix-domain sockets but libssh doesn't have an API for that, hence this
- ;; hack.
- `(begin
- (use-modules (ice-9 match) (rnrs io ports))
-
- (let ((sock (socket AF_UNIX SOCK_STREAM 0))
- (stdin (current-input-port))
- (stdout (current-output-port)))
- (setvbuf stdin _IONBF)
- (setvbuf stdout _IONBF)
- (connect sock AF_UNIX ,socket-name)
-
- (let loop ()
- (match (select (list stdin sock) '() (list stdin stdout sock))
- ((reads writes ())
- (when (memq stdin reads)
- (match (get-bytevector-some stdin)
- ((? eof-object?)
- (primitive-exit 0))
- (bv
- (put-bytevector sock bv))))
- (when (memq sock reads)
- (match (get-bytevector-some sock)
- ((? eof-object?)
- (primitive-exit 0))
- (bv
- (put-bytevector stdout bv))))
- (loop))
- (_
- (primitive-exit 1)))))))
-
- (let ((channel
- (open-remote-pipe* session OPEN_BOTH
- ;; Sort-of shell-quote REDIRECT.
- "guile" "-c"
- (object->string
- (object->string redirect)))))
- (open-connection #:port channel)))
-
;;;
;;; Synchronization.
@@ -382,8 +336,9 @@ MACHINE."
;; Protect DRV from garbage collection.
(add-temp-root store (derivation-file-name drv))
- (send-files (cons (derivation-file-name drv) inputs)
- store)
+ (with-store local
+ (send-files local (cons (derivation-file-name drv) inputs) store
+ #:log-port (current-output-port)))
(format (current-error-port) "offloading '~a' to '~a'...~%"
(derivation-file-name drv) (build-machine-name machine))
(format (current-error-port) "@ build-remote ~a ~a~%"
@@ -401,93 +356,17 @@ MACHINE."
(parameterize ((current-build-output-port (build-log-port)))
(build-derivations store (list drv))))
- (retrieve-files outputs store)
+ (retrieve-files* outputs store)
(format (current-error-port) "done with offloaded '~a'~%"
(derivation-file-name drv)))
-(define (store-import-channel session)
- "Return an output port to which archives to be exported to SESSION's store
-can be written."
- ;; Using the 'import-paths' RPC on a remote store would be slow because it
- ;; makes a round trip every time 32Â KiB have been transferred. This
- ;; procedure instead opens a separate channel to use the remote
- ;; 'import-paths' procedure, which consumes all the data in a single round
- ;; trip.
- (define import
- `(begin
- (use-modules (guix))
-
- (with-store store
- (setvbuf (current-input-port) _IONBF)
- (import-paths store (current-input-port)))))
-
- (open-remote-output-pipe session
- (string-join
- `("guile" "-c"
- ,(object->string
- (object->string import))))))
-
-(define (store-export-channel session files)
- "Return an input port from which an export of FILES from SESSION's store can
-be read."
- ;; Same as above: this is more efficient than calling 'export-paths' on a
- ;; remote store.
- (define export
- `(begin
- (use-modules (guix))
-
- (with-store store
- (setvbuf (current-output-port) _IONBF)
- (export-paths store ',files (current-output-port)))))
-
- (open-remote-input-pipe session
- (string-join
- `("guile" "-c"
- ,(object->string
- (object->string export))))))
-
-(define (send-files files remote)
- "Send the subset of FILES that's missing to REMOTE, a remote store."
- (with-store store
- ;; Compute the subset of FILES missing on SESSION and send them.
- (let* ((session (channel-get-session (nix-server-socket remote)))
- (node (make-node session))
- (missing (node-eval node
- `(begin
- (use-modules (guix)
- (srfi srfi-1) (srfi srfi-26))
-
- (with-store store
- (remove (cut valid-path? store <>)
- ',files)))))
- (count (length missing))
- (port (store-import-channel session)))
- (format #t (N_ "sending ~a store item to '~a'...~%"
- "sending ~a store items to '~a'...~%" count)
- count (session-get session 'host))
-
- ;; Send MISSING in topological order.
- (export-paths store missing port)
-
- ;; Tell the remote process that we're done. (In theory the
- ;; end-of-archive mark of 'export-paths' would be enough, but in
- ;; practice it's not.)
- (channel-send-eof port)
-
- ;; Wait for completion of the remote process.
- (let ((result (zero? (channel-get-exit-status port))))
- (close-port port)
- result))))
-
-(define (retrieve-files files remote)
- "Retrieve FILES from SESSION's store, and import them."
- (let* ((session (channel-get-session (nix-server-socket remote)))
- (host (session-get session 'host))
- (port (store-export-channel session files))
- (count (length files)))
+(define (retrieve-files* files remote)
+ "Retrieve FILES from REMOTE and import them using 'restore-file-set'."
+ (let-values (((port count)
+ (file-retrieval-port files remote)))
(format #t (N_ "retrieving ~a store item from '~a'...~%"
"retrieving ~a store items from '~a'...~%" count)
- count host)
+ count (remote-store-host remote))
;; We cannot use the 'import-paths' RPC here because we already
;; hold the locks for FILES.
@@ -677,8 +556,8 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
(delay
(seed->random-state (logxor (getpid) (car (gettimeofday))))))
-(define (nonce)
- (string-append (gethostname) "-"
+(define* (nonce #:optional (name (gethostname)))
+ (string-append name "-"
(number->string (random 1000000 (force %random-state)))))
(define (assert-node-can-import node name daemon-socket)
@@ -687,7 +566,9 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
(with-store store
(let* ((item (add-text-to-store store "export-test" (nonce)))
(remote (connect-to-remote-daemon session daemon-socket)))
- (send-files (list item) remote)
+ (with-store local
+ (send-files local (list item) remote))
+
(if (valid-path? remote item)
(info (_ "'~a' successfully imported '~a'~%")
name item)
@@ -698,10 +579,9 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
"Bail out if we cannot import signed archives from NODE."
(let* ((session (node-session node))
(remote (connect-to-remote-daemon session daemon-socket))
- (item (add-text-to-store remote "import-test" (nonce)))
- (port (store-export-channel session (list item))))
+ (item (add-text-to-store remote "import-test" (nonce name))))
(with-store store
- (if (and (import-paths store port)
+ (if (and (retrieve-files store (list item) remote)
(valid-path? store item))
(info (_ "successfully imported '~a' from '~a'~%")
item name)
diff --git a/guix/ssh.scm b/guix/ssh.scm
new file mode 100644
index 0000000..e07d761
--- /dev/null
+++ b/guix/ssh.scm
@@ -0,0 +1,204 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Ludovic Courtès <address@hidden>
+;;;
+;;; 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 ssh)
+ #:use-module (guix store)
+ #:autoload (guix ui) (N_)
+ #:use-module (ssh channel)
+ #:use-module (ssh popen)
+ #:use-module (ssh session)
+ #:use-module (ssh dist)
+ #:use-module (ssh dist node)
+ #:use-module (srfi srfi-11)
+ #:use-module (ice-9 match)
+ #:export (connect-to-remote-daemon
+ send-files
+ retrieve-files
+ remote-store-host
+
+ file-retrieval-port))
+
+;;; Commentary:
+;;;
+;;; This module provides tools to support communication with remote stores
+;;; over SSH, using Guile-SSH.
+;;;
+;;; Code:
+
+(define* (connect-to-remote-daemon session
+ #:optional
+ (socket-name
"/var/guix/daemon-socket/socket"))
+ "Connect to the remote build daemon listening on SOCKET-NAME over SESSION,
+an SSH session. Return a <nix-server> object."
+ (define redirect
+ ;; Code run in SESSION to redirect the remote process' stdin/stdout to the
+ ;; daemon's socket, Ã la socat. The SSH protocol supports forwarding to
+ ;; Unix-domain sockets but libssh doesn't have an API for that, hence this
+ ;; hack.
+ `(begin
+ (use-modules (ice-9 match) (rnrs io ports))
+
+ (let ((sock (socket AF_UNIX SOCK_STREAM 0))
+ (stdin (current-input-port))
+ (stdout (current-output-port)))
+ (setvbuf stdin _IONBF)
+ (setvbuf stdout _IONBF)
+ (connect sock AF_UNIX ,socket-name)
+
+ (let loop ()
+ (match (select (list stdin sock) '() (list stdin stdout sock))
+ ((reads writes ())
+ (when (memq stdin reads)
+ (match (get-bytevector-some stdin)
+ ((? eof-object?)
+ (primitive-exit 0))
+ (bv
+ (put-bytevector sock bv))))
+ (when (memq sock reads)
+ (match (get-bytevector-some sock)
+ ((? eof-object?)
+ (primitive-exit 0))
+ (bv
+ (put-bytevector stdout bv))))
+ (loop))
+ (_
+ (primitive-exit 1)))))))
+
+ (let ((channel
+ (open-remote-pipe* session OPEN_BOTH
+ ;; Sort-of shell-quote REDIRECT.
+ "guile" "-c"
+ (object->string
+ (object->string redirect)))))
+ (open-connection #:port channel)))
+
+(define (store-import-channel session)
+ "Return an output port to which archives to be exported to SESSION's store
+can be written."
+ ;; Using the 'import-paths' RPC on a remote store would be slow because it
+ ;; makes a round trip every time 32Â KiB have been transferred. This
+ ;; procedure instead opens a separate channel to use the remote
+ ;; 'import-paths' procedure, which consumes all the data in a single round
+ ;; trip.
+ (define import
+ `(begin
+ (use-modules (guix))
+
+ (with-store store
+ (setvbuf (current-input-port) _IONBF)
+
+ ;; FIXME: Exceptions are silently swallowed. We should report them
+ ;; somehow.
+ (import-paths store (current-input-port)))))
+
+ (open-remote-output-pipe session
+ (string-join
+ `("guile" "-c"
+ ,(object->string
+ (object->string import))))))
+
+(define (store-export-channel session files)
+ "Return an input port from which an export of FILES from SESSION's store can
+be read."
+ ;; Same as above: this is more efficient than calling 'export-paths' on a
+ ;; remote store.
+ (define export
+ `(begin
+ (use-modules (guix))
+
+ (with-store store
+ (setvbuf (current-output-port) _IONBF)
+
+ ;; FIXME: Exceptions are silently swallowed. We should report them
+ ;; somehow.
+ (export-paths store ',files (current-output-port)))))
+
+ (open-remote-input-pipe session
+ (string-join
+ `("guile" "-c"
+ ,(object->string
+ (object->string export))))))
+
+(define* (send-files local files remote
+ #:key (log-port (current-error-port)))
+ "Send the subset of FILES from LOCAL (a local store) that's missing to
+REMOTE, a remote store."
+ ;; Compute the subset of FILES missing on SESSION and send them.
+ (let* ((session (channel-get-session (nix-server-socket remote)))
+ (node (make-node session))
+ (missing (node-eval node
+ `(begin
+ (use-modules (guix)
+ (srfi srfi-1) (srfi srfi-26))
+
+ (with-store store
+ (remove (cut valid-path? store <>)
+ ',files)))))
+ (count (length missing))
+ (port (store-import-channel session)))
+ (format log-port (N_ "sending ~a store item to '~a'...~%"
+ "sending ~a store items to '~a'...~%" count)
+ count (session-get session 'host))
+
+ ;; Send MISSING in topological order.
+ (export-paths local missing port)
+
+ ;; Tell the remote process that we're done. (In theory the end-of-archive
+ ;; mark of 'export-paths' would be enough, but in practice it's not.)
+ (channel-send-eof port)
+
+ ;; Wait for completion of the remote process.
+ (let ((result (zero? (channel-get-exit-status port))))
+ (close-port port)
+ result)))
+
+(define (remote-store-session remote)
+ "Return the SSH channel beneath REMOTE, a remote store as returned by
+'connect-to-remote-daemon', or #f."
+ (channel-get-session (nix-server-socket remote)))
+
+(define (remote-store-host remote)
+ "Return the name of the host REMOTE is connected to, where REMOTE is a
+remote store as returned by 'connect-to-remote-daemon'."
+ (match (remote-store-session remote)
+ (#f #f)
+ ((? session? session)
+ (session-get session 'host))))
+
+(define (file-retrieval-port files remote)
+ "Return an input port from which to retrieve FILES (a list of store items)
+from REMOTE, along with the number of items to retrieve (lower than or equal
+to the length of FILES.)"
+ (values (store-export-channel (remote-store-session remote) files)
+ (length files)))
+
+(define* (retrieve-files local files remote
+ #:key (log-port (current-error-port)))
+ "Retrieve FILES from REMOTE and import them using the 'import-paths' RPC on
+LOCAL."
+ (let-values (((port count)
+ (file-retrieval-port files remote)))
+ (format #t (N_ "retrieving ~a store item from '~a'...~%"
+ "retrieving ~a store items from '~a'...~%" count)
+ count (remote-store-host remote))
+
+ (let ((result (import-paths local port)))
+ (close-port port)
+ result)))
+
+;;; ssh.scm ends here