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.

1 files changed, 204 insertions, 0 deletions

diff --git a/guix/ssh.scm b/guix/ssh.scm
new file mode 100644
index 0000000000..e07d7612c6
--- /dev/null
+++ b/guix/ssh.scm
@@ -0,0 +1,204 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 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 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