;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (guix scripts)
#:use-module (guix ssh)
#:use-module (guix store)
+ #:use-module ((guix status) #:select (with-status-verbosity))
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix scripts build)
((? integer? port)
(values user host port))
(x
- (leave (_ "~a: invalid TCP port number~%") port))))
+ (leave (G_ "~a: invalid TCP port number~%") port))))
(x
- (leave (_ "~a: invalid SSH specification~%") spec))))
+ (leave (G_ "~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 ;
(and (or (assoc-ref opts 'dry-run?)
(build-derivations local drv))
- (let* ((session (open-ssh-session host #:user user #:port port))
+ (let* ((session (open-ssh-session host #:user user
+ #:port (or port 22)))
(sent (send-files local items
(connect-to-remote-daemon session)
#:recursive? #t)))
(let*-values (((user host port)
(ssh-spec->user+host+port source))
((session)
- (open-ssh-session host #:user user #:port port))
+ (open-ssh-session host #:user user #:port (or port 22)))
((remote)
(connect-to-remote-daemon session)))
(set-build-options-from-command-line local opts)
;;;
(define (show-help)
- (display (_ "Usage: guix copy [OPTION]... ITEMS...
+ (display (G_ "Usage: guix copy [OPTION]... ITEMS...
Copy ITEMS to or from the specified host over SSH.\n"))
- (display (_ "
+ (display (G_ "
--to=HOST send ITEMS to HOST"))
- (display (_ "
+ (display (G_ "
--from=HOST receive ITEMS from HOST"))
+ (display (G_ "
+ -v, --verbosity=LEVEL use the given verbosity LEVEL"))
(newline)
(show-build-options-help)
(newline)
- (display (_ "
+ (display (G_ "
-h, --help display this help and exit"))
- (display (_ "
+ (display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(option '("from") #t #f
(lambda (opt name arg result)
(alist-cons 'source arg result)))
+ (option '(#\v "verbosity") #t #f
+ (lambda (opt name arg result)
+ (let ((level (string->number* arg)))
+ (alist-cons 'verbosity level
+ (alist-delete 'verbosity result)))))
(option '(#\h "help") #f #f
(lambda args
(show-help)
(define %default-options
`((system . ,(%current-system))
(substitutes? . #t)
+ (build-hook? . #t)
(graft? . #t)
- (max-silent-time . 3600)
- (verbosity . 0)))
+ (print-build-trace? . #t)
+ (print-extended-build-trace? . #t)
+ (multiplexed-build-output? . #t)
+ (debug . 0)
+ (verbosity . 2)))
\f
;;;
(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'~%")))))))
+ (with-status-verbosity (assoc-ref opts 'verbosity)
+ (cond (target (send-to-remote-host target opts))
+ (source (retrieve-from-remote-host source opts))
+ (else (leave (G_ "use '--to' or '--from'~%"))))))))