nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add 'guix copy'. 

* guix/scripts/copy.scm: New file.
* guix/scripts/archive.scm (options->derivations+files): Export.
* doc/guix.texi (Invoking guix copy): New node.
* Makefile.am (MODULES) [HAVE_GUILE_SSH]: Add guix/scripts/copy.scm.
* po/guix/POTFILES.in: Likewise.
This commit is contained in:
Ludovic Courtès 2016-12-31 18:19:56 +01:00
parent 13164a2102
commit f11c444d44
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
5 changed files with 285 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Makefile.am
View File

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

73
doc/guix.texi
View File

@ -145,6 +145,7 @@ 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}
@ -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
@ -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}

3
guix/scripts/archive.scm
View File

@ -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))
;;;

207
guix/scripts/copy.scm Normal file
View File

@ -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'~%")))))))

1
po/guix/POTFILES.in
View File

@ -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