lint: Use the 'warning' procedure for messages.
[jackhill/guix/guix.git] / guix / scripts / copy.scm
index bc22504..ce70f2f 100644 (file)
@@ -1,5 +1,5 @@
 ;;; 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.
 ;;;
@@ -21,6 +21,7 @@
   #: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)
@@ -56,9 +57,9 @@ number (or #f) corresponding to SPEC."
        ((? 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 ;
@@ -75,7 +76,8 @@ package names, build the underlying packages before sending them."
 
       (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)))
@@ -88,7 +90,7 @@ package names, build the underlying packages before sending them."
     (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)
@@ -109,18 +111,20 @@ package names, build the underlying packages before sending them."
 ;;;
 
 (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))
@@ -133,6 +137,11 @@ Copy ITEMS to or from the specified host over SSH.\n"))
          (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)
@@ -149,9 +158,13 @@ Copy ITEMS to or from the specified host over SSH.\n"))
 (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
 ;;;
@@ -163,6 +176,7 @@ Copy ITEMS to or from the specified host over SSH.\n"))
     (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'~%"))))))))