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:
		
							parent
							
								
									13164a2102
								
							
						
					
					
						commit
						f11c444d44
					
				
					 5 changed files with 285 additions and 6 deletions
				
			
		|  | @ -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)) | ||||
| 
 | ||||
|  | ||||
| ;;; | ||||
|  |  | |||
							
								
								
									
										207
									
								
								guix/scripts/copy.scm
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										207
									
								
								guix/scripts/copy.scm
									
										
									
									
									
										Normal 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'~%"))))))) | ||||
|  | @ -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 | ||||
|  |  | |||
		Reference in a new issue