5 files changed, 285 insertions(+), 6 deletions(-)

M Makefile.am
M doc/guix.texi
M guix/scripts/archive.scm
A guix/scripts/copy.scm
M po/guix/POTFILES.in

@@ 173,7 173,8 @@ endif
 if HAVE_GUILE_SSH
 
 MODULES +=					\
-  guix/ssh.scm
+  guix/ssh.scm					\
+  guix/scripts/copy.scm
 
 endif HAVE_GUILE_SSH
 

@@ 145,12 145,13 @@ Utilities
 * Invoking guix environment::   Setting up development environments.
 * Invoking guix publish::       Sharing substitutes.
 * Invoking guix challenge::     Challenging substitute servers.
+* Invoking guix copy::          Copying to and from a remote store.
 * Invoking guix container::     Process isolation.
 
 Invoking @command{guix build}
 
 * Common Build Options::        Build options for most commands.
-* Package Transformation Options::    Creating variants of packages.
+* Package Transformation Options::  Creating variants of packages.
 * Additional Build Options::    Options specific to 'guix build'.
 
 GNU Distribution


@@ 199,12 200,14 @@ Services
 * Log Rotation::                The rottlog service.
 * Networking Services::         Network setup, SSH daemon, etc.
 * X Window::                    Graphical display.
+* Printing Services::           Local and remote printer support.
 * Desktop Services::            D-Bus and desktop services.
 * Database Services::           SQL databases.
 * Mail Services::               IMAP, POP3, SMTP, and all that.
 * Kerberos Services::           Kerberos services.
 * Web Services::                Web servers.
 * Network File System::         NFS related services.
+* Continuous Integration::      The Cuirass service.
 * Miscellaneous Services::      Other services.
 
 Defining Services


@@ 551,7 554,8 @@ interest primarily for developers and not for casual users.
 
 @item
 @c Note: We need at least 0.10.2 for 'channel-send-eof'.
-Support for build offloading (@pxref{Daemon Offload Setup}) depends on
+Support for build offloading (@pxref{Daemon Offload Setup}) and
+@command{guix copy} (@pxref{Invoking guix copy}) depends on
 @uref{https://github.com/artyom-poptsov/guile-ssh, Guile-SSH},
 version 0.10.2 or later.
 


@@ 2384,7 2388,9 @@ However, note that, in both examples, all of @code{emacs} and the
 profile as well as all of their dependencies are transferred (due to
 @code{-r}), regardless of what is already available in the store on the
 target machine.  The @code{--missing} option can help figure out which
-items are missing from the target store.
+items are missing from the target store.  The @command{guix copy}
+command simplifies and optimizes this whole process, so this is probably
+what you should use in this case (@pxref{Invoking guix copy}).
 
 @cindex nar, archive format
 @cindex normalized archive (nar)


@@ 4415,6 4421,7 @@ the Scheme programming interface of Guix in a convenient way.
 * Invoking guix environment::   Setting up development environments.
 * Invoking guix publish::       Sharing substitutes.
 * Invoking guix challenge::     Challenging substitute servers.
+* Invoking guix copy::          Copying to and from a remote store.
 * Invoking guix container::     Process isolation.
 @end menu
 


@@ 4467,7 4474,7 @@ described in the subsections below.
 
 @menu
 * Common Build Options::        Build options for most commands.
-* Package Transformation Options::    Creating variants of packages.
+* Package Transformation Options::  Creating variants of packages.
 * Additional Build Options::    Options specific to 'guix build'.
 @end menu
 


@@ 6371,6 6378,68 @@ URLs to compare to.
 
 @end table
 
+@node Invoking guix copy
+@section Invoking @command{guix copy}
+
+@cindex copy, of store items, over SSH
+@cindex SSH, copy of store items
+@cindex sharing store items across machines
+@cindex transferring store items across machines
+The @command{guix copy} command copies items from the store of one
+machine to that of another machine over a secure shell (SSH)
+connection@footnote{This command is available only when Guile-SSH was
+found.  @xref{Requirements}, for details.}.  For example, the following
+command copies the @code{coreutils} package, the user's profile, and all
+their dependencies over to @var{host}, logged in as @var{user}:
+
+@example
+guix copy --to=@var{user}@@@var{host} \
+          coreutils `readlink -f ~/.guix-profile`
+@end example
+
+If some of the items to be copied are already present on @var{host},
+they are not actually sent.
+
+The command below retrieves @code{libreoffice} and @code{gimp} from
+@var{host}, assuming they are available there:
+
+@example
+guix copy --from=@var{host} libreoffice gimp
+@end example
+
+The SSH connection is established using the Guile-SSH client, which is
+compatible with OpenSSH: it honors @file{~/.ssh/known_hosts} and
+@file{~/.ssh/config}, and uses the SSH agent for authentication.
+
+The key used to sign items that are sent must be accepted by the remote
+machine.  Likewise, the key used by the remote machine to sign items you
+are retrieving must be in @file{/etc/guix/acl} so it is accepted by your
+own daemon.  @xref{Invoking guix archive}, for more information about
+store item authentication.
+
+The general syntax is:
+
+@example
+guix copy [--to=@var{spec}|--from=@var{spec}] @var{items}@dots{}
+@end example
+
+You must always specify one of the following options:
+
+@table @code
+@item --to=@var{spec}
+@itemx --from=@var{spec}
+Specify the host to send to or receive from.  @var{spec} must be an SSH
+spec such as @code{example.org}, @code{charlie@@example.org}, or
+@code{charlie@@example.org:2222}.
+@end table
+
+The @var{items} can be either package names, such as @code{gimp}, or
+store items, such as @file{/gnu/store/@dots{}-idutils-4.6}.
+
+When specifying the name of a package to send, it is first built if
+needed, unless @option{--dry-run} was specified.  Common build options
+are supported (@pxref{Common Build Options}).
+
 
 @node Invoking guix container
 @section Invoking @command{guix container}

@@ 41,7 41,8 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 binary-ports)
-  #:export (guix-archive))
+  #:export (guix-archive
+            options->derivations+files))
 
 
 ;;;

@@ 0,0 1,207 @@
+;;; 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 scripts copy)
+  #:use-module (guix ui)
+  #:use-module (guix scripts)
+  #:use-module (guix ssh)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix derivations)
+  #:use-module (guix scripts build)
+  #:use-module ((guix scripts archive) #:select (options->derivations+files))
+  #:use-module (ssh session)
+  #:use-module (ssh auth)
+  #:use-module (ssh key)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:export (guix-copy))
+
+
+;;;
+;;; Exchanging store items over SSH.
+;;;
+
+(define %compression
+  "zlib@openssh.com,zlib")
+
+(define* (open-ssh-session host #:key user port)
+  "Open an SSH session for HOST and return it.  When USER and PORT are #f, use
+default values or whatever '~/.ssh/config' specifies; otherwise use them.
+Throw an error on failure."
+  (let ((session (make-session #:user user
+                               #:host host
+                               #:port port
+                               #:timeout 10       ;seconds
+                               ;; #:log-verbosity 'protocol
+
+                               ;; We need lightweight compression when
+                               ;; exchanging full archives.
+                               #:compression %compression
+                               #:compression-level 3)))
+
+    ;; Honor ~/.ssh/config.
+    (session-parse-config! session)
+
+    (match (connect! session)
+      ('ok
+       ;; Let the SSH agent authenticate us to the server.
+       (match (userauth-agent! session)
+         ('success
+          session)
+         (x
+          (disconnect! session)
+          (leave (_ "SSH authentication failed for '~a': ~a~%")
+                 host (get-error session)))))
+      (x
+       ;; Connection failed or timeout expired.
+       (leave (_ "SSH connection to '~a' failed: ~a~%")
+              host (get-error session))))))
+
+(define (ssh-spec->user+host+port spec)
+  "Parse SPEC, a string like \"user@host:port\" or just \"host\", and return
+three values: the user name (or #f), the host name, and the TCP port
+number (or #f) corresponding to SPEC."
+  (define tokens
+    (char-set #\@ #\:))
+
+  (match (string-tokenize spec (char-set-complement tokens))
+    ((host)
+     (values #f host #f))
+    ((left right)
+     (if (string-index spec #\@)
+         (values left right #f)
+         (values #f left (string->number right))))
+    ((user host port)
+     (match (string->number port)
+       ((? integer? port)
+        (values user host port))
+       (x
+        (leave (_ "~a: invalid TCP port number~%") port))))
+    (x
+     (leave (_ "~a: invalid SSH specification~%") spec))))
+
+(define (send-to-remote-host target opts)
+  "Send ITEMS to TARGET.  ITEMS is a list of store items or package names; for ;
+package names, build the underlying packages before sending them."
+  (with-store local
+    (set-build-options-from-command-line local opts)
+    (let-values (((user host port)
+                  (ssh-spec->user+host+port target))
+                 ((drv items)
+                  (options->derivations+files local opts)))
+      (show-what-to-build local drv
+                          #:use-substitutes? (assoc-ref opts 'substitutes?)
+                          #:dry-run? (assoc-ref opts 'dry-run?))
+
+      (and (or (assoc-ref opts 'dry-run?)
+               (build-derivations local drv))
+           (let* ((session (open-ssh-session host #:user user #:port port))
+                  (sent    (send-files local items
+                                       (connect-to-remote-daemon session)
+                                       #:recursive? #t)))
+             (format #t "~{~a~%~}" sent)
+             sent)))))
+
+(define (retrieve-from-remote-host source opts)
+  "Retrieve ITEMS from SOURCE."
+  (with-store local
+    (let*-values (((user host port)
+                   (ssh-spec->user+host+port source))
+                  ((session)
+                   (open-ssh-session host #:user user #:port port))
+                  ((remote)
+                   (connect-to-remote-daemon session)))
+      (set-build-options-from-command-line local opts)
+      ;; TODO: Here we could to compute and build the derivations on REMOTE
+      ;; rather than on LOCAL (one-off offloading) but that is currently too
+      ;; slow due to the many RPC round trips.  So we just assume that REMOTE
+      ;; contains ITEMS.
+      (let*-values (((drv items)
+                     (options->derivations+files local opts))
+                    ((retrieved)
+                     (retrieve-files local items remote #:recursive? #t)))
+        (format #t "~{~a~%~}" retrieved)
+        retrieved))))
+
+
+;;;
+;;; Options.
+;;;
+
+(define (show-help)
+  (display (_ "Usage: guix copy [OPTION]... ITEMS...
+Copy ITEMS to or from the specified host over SSH.\n"))
+  (display (_ "
+      --to=HOST          send ITEMS to HOST"))
+  (display (_ "
+      --from=HOST        receive ITEMS from HOST"))
+  (newline)
+  (show-build-options-help)
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specifications of the command-line options.
+  (cons* (option '("to") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'destination arg result)))
+         (option '("from") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'source arg result)))
+         (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix copy")))
+         (option '(#\s "system") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'system arg
+                               (alist-delete 'system result eq?))))
+         %standard-build-options))
+
+(define %default-options
+  `((system . ,(%current-system))
+    (substitutes? . #t)
+    (graft? . #t)
+    (max-silent-time . 3600)
+    (verbosity . 0)))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-copy . args)
+  (with-error-handling
+    (let* ((opts     (parse-command-line args %options (list %default-options)))
+           (source   (assoc-ref opts 'source))
+           (target   (assoc-ref opts 'destination)))
+      (cond (target (send-to-remote-host target opts))
+            (source (retrieve-from-remote-host source opts))
+            (else   (leave (_ "use '--to' or '--from'~%")))))))

@@ 24,6 24,7 @@ guix/scripts/edit.scm
 guix/scripts/size.scm
 guix/scripts/graph.scm
 guix/scripts/challenge.scm
+guix/scripts/copy.scm
 guix/gnu-maintenance.scm
 guix/scripts/container.scm
 guix/scripts/container/exec.scm