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

deploy: Add '--verbosity' and properly interpret build log. 

This is a followup to 91300526b7.

* guix/scripts/deploy.scm (show-help, %options): Add '--verbosity'.
(guix-deploy): Wrap 'with-store' in 'with-status-verbosity'.
master
Ludovic Courtès 2019-09-23 11:57:39 +02:00
parent 90ca791ab0
commit b69ce8a872
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
guix/scripts/deploy.scm
View File

@ -26,6 +26,7 @@
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix grafts)
#:use-module (guix status)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
@ -52,6 +53,8 @@ Perform the deployment specified by FILE.\n"))
(display (G_ "
-V, --version display version information and exit"))
(newline)
(display (G_ "
-v, --verbosity=LEVEL use the given verbosity LEVEL"))
(show-bug-report-information))
(define %options
@ -63,6 +66,12 @@ Perform the deployment specified by FILE.\n"))
(lambda (opt name arg result)
(alist-cons 'system arg
(alist-delete 'system result eq?))))
(option '(#\v "verbosity") #t #f
(lambda (opt name arg result)
(let ((level (string->number* arg)))
(alist-cons 'verbosity level
(alist-delete 'verbosity result)))))
%standard-build-options))
(define %default-options
@ -87,25 +96,27 @@ Perform the deployment specified by FILE.\n"))
(define (guix-deploy . args)
(define (handle-argument arg result)
(alist-cons 'file arg result))
(let* ((opts (parse-command-line args %options (list %default-options)
#:argument-handler handle-argument))
(file (assq-ref opts 'file))
(machines (or (and file (load-source-file file)) '())))
(with-store store
(set-build-options-from-command-line store opts)
(for-each (lambda (machine)
(info (G_ "deploying to ~a...~%")
(machine-display-name machine))
(parameterize ((%graft? (assq-ref opts 'graft?)))
(guard (c ((message-condition? c)
(report-error (G_ "failed to deploy ~a: ~a~%")
(machine-display-name machine)
(condition-message c)))
((deploy-error? c)
(when (deploy-error-should-roll-back c)
(info (G_ "rolling back ~a...~%")
(machine-display-name machine))
(run-with-store store (roll-back-machine machine)))
(apply throw (deploy-error-captured-args c))))
(run-with-store store (deploy-machine machine)))))
machines))))
(with-status-verbosity (assoc-ref opts 'verbosity)
(with-store store
(set-build-options-from-command-line store opts)
(for-each (lambda (machine)
(info (G_ "deploying to ~a...~%")
(machine-display-name machine))
(parameterize ((%graft? (assq-ref opts 'graft?)))
(guard (c ((message-condition? c)
(report-error (G_ "failed to deploy ~a: ~a~%")
(machine-display-name machine)
(condition-message c)))
((deploy-error? c)
(when (deploy-error-should-roll-back c)
(info (G_ "rolling back ~a...~%")
(machine-display-name machine))
(run-with-store store (roll-back-machine machine)))
(apply throw (deploy-error-captured-args c))))
(run-with-store store (deploy-machine machine)))))
machines)))))