1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or (at
9 ;;; your option) any later version.
11 ;;; GNU Guix is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 (define-module (guix scripts copy)
20 #:use-module (guix ui)
21 #:use-module (guix scripts)
22 #:use-module (guix ssh)
23 #:use-module (guix store)
24 #:use-module (guix utils)
25 #:use-module (guix derivations)
26 #:use-module (guix scripts build)
27 #:use-module ((guix scripts archive) #:select (options->derivations+files))
28 #:use-module (srfi srfi-1)
29 #:use-module (srfi srfi-11)
30 #:use-module (srfi srfi-37)
31 #:use-module (ice-9 match)
32 #:use-module (ice-9 format)
37 ;;; Exchanging store items over SSH.
40 (define (ssh-spec->user+host+port spec)
41 "Parse SPEC, a string like \"user@host:port\" or just \"host\", and return
42 three values: the user name (or #f), the host name, and the TCP port
43 number (or #f) corresponding to SPEC."
47 (match (string-tokenize spec (char-set-complement tokens))
51 (if (string-index spec #\@)
52 (values left right #f)
53 (values #f left (string->number right))))
55 (match (string->number port)
57 (values user host port))
59 (leave (G_ "~a: invalid TCP port number~%") port))))
61 (leave (G_ "~a: invalid SSH specification~%") spec))))
63 (define (send-to-remote-host target opts)
64 "Send ITEMS to TARGET. ITEMS is a list of store items or package names; for ;
65 package names, build the underlying packages before sending them."
67 (set-build-options-from-command-line local opts)
68 (let-values (((user host port)
69 (ssh-spec->user+host+port target))
71 (options->derivations+files local opts)))
72 (show-what-to-build local drv
73 #:use-substitutes? (assoc-ref opts 'substitutes?)
74 #:dry-run? (assoc-ref opts 'dry-run?))
76 (and (or (assoc-ref opts 'dry-run?)
77 (build-derivations local drv))
78 (let* ((session (open-ssh-session host #:user user #:port port))
79 (sent (send-files local items
80 (connect-to-remote-daemon session)
82 (format #t "~{~a~%~}" sent)
85 (define (retrieve-from-remote-host source opts)
86 "Retrieve ITEMS from SOURCE."
88 (let*-values (((user host port)
89 (ssh-spec->user+host+port source))
91 (open-ssh-session host #:user user #:port port))
93 (connect-to-remote-daemon session)))
94 (set-build-options-from-command-line local opts)
95 ;; TODO: Here we could to compute and build the derivations on REMOTE
96 ;; rather than on LOCAL (one-off offloading) but that is currently too
97 ;; slow due to the many RPC round trips. So we just assume that REMOTE
99 (let*-values (((drv items)
100 (options->derivations+files local opts))
102 (retrieve-files local items remote #:recursive? #t)))
103 (format #t "~{~a~%~}" retrieved)
112 (display (G_ "Usage: guix copy [OPTION]... ITEMS...
113 Copy ITEMS to or from the specified host over SSH.\n"))
115 --to=HOST send ITEMS to HOST"))
117 --from=HOST receive ITEMS from HOST"))
119 (show-build-options-help)
122 -h, --help display this help and exit"))
124 -V, --version display version information and exit"))
126 (show-bug-report-information))
129 ;; Specifications of the command-line options.
130 (cons* (option '("to") #t #f
131 (lambda (opt name arg result)
132 (alist-cons 'destination arg result)))
133 (option '("from") #t #f
134 (lambda (opt name arg result)
135 (alist-cons 'source arg result)))
136 (option '(#\h "help") #f #f
140 (option '(#\V "version") #f #f
142 (show-version-and-exit "guix copy")))
143 (option '(#\s "system") #t #f
144 (lambda (opt name arg result)
145 (alist-cons 'system arg
146 (alist-delete 'system result eq?))))
147 %standard-build-options))
149 (define %default-options
150 `((system . ,(%current-system))
153 (max-silent-time . 3600)
161 (define (guix-copy . args)
163 (let* ((opts (parse-command-line args %options (list %default-options)))
164 (source (assoc-ref opts 'source))
165 (target (assoc-ref opts 'destination)))
166 (cond (target (send-to-remote-host target opts))
167 (source (retrieve-from-remote-host source opts))
168 (else (leave (G_ "use '--to' or '--from'~%")))))))