From 987a29ba43cc8a2751eafe392906d240713c724e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 30 Dec 2016 23:22:27 +0100 Subject: 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. --- guix/ssh.scm | 204 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 204 insertions(+) create mode 100644 guix/ssh.scm (limited to 'guix/ssh.scm') 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 +;;; +;;; 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 . + +(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 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 -- cgit v1.2.3