diff options
Diffstat (limited to 'scripts/guix-build-coordinator.in')
| -rw-r--r-- | scripts/guix-build-coordinator.in | 54 |
1 files changed, 40 insertions, 14 deletions
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 86f604f..0c06579 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -58,15 +58,6 @@ (guix-build-coordinator build-allocator) (guix-build-coordinator client-communication)) -(install-suspendable-ports!) - -;; TODO Work around this causing problems with backtraces -;; https://github.com/wingo/fibers/issues/76 -(set-record-type-printer! - (@@ (fibers scheduler) <scheduler>) - (lambda (scheduler port) - (display "#<scheduler>" port))) - (define %base-options ;; Specifications of the command-line options (list (option '("secret-key-base-file") #t #f @@ -83,6 +74,13 @@ (option '("update-database") #f #f (lambda (opt name _ result) (alist-cons 'update-database #t result))) + (option '("listen-repl") #f #t + (lambda (opt name arg result) + (alist-cons 'listen-repl + (if arg + (string->number arg) + #t) + (alist-delete 'listen-repl result)))) (option '("show-error-details") #f #f (lambda (opt name _ result) (alist-cons 'show-error-details #t result))))) @@ -295,6 +293,16 @@ (or (assq-ref result 'not-systems) '())) (alist-delete 'not-systems result)))) + (option '("created-at-gt") #t #f + (lambda (opt name arg result) + (alist-cons 'created-at-> + (datastore-validate-datetime-string arg) + result))) + (option '("created-at-lt") #t #f + (lambda (opt name arg result) + (alist-cons 'created-at-< + (datastore-validate-datetime-string arg) + result))) (option '("skip-updating-derived-priorities") #f #f (lambda (opt name _ result) (alist-cons 'skip-updating-derived-priorities @@ -414,7 +422,12 @@ "error: ~A is not a known allocation strategy\n" arg) (exit 1))) - result)))) + result))) + (option '("timestamp-log-output") #t #f + (lambda (opt name arg result) + (alist-cons 'timestamp-log-output? + (string=? arg "true") + result)))) (append-map (lambda (hook) (list @@ -660,6 +673,8 @@ tags: #:not-tags (assq-ref opts 'not-tags) #:systems (assq-ref opts 'systems) #:not-systems (assq-ref opts 'not-systems) + #:created-at-< (assq-ref opts 'created-at-<) + #:created-at-> (assq-ref opts 'created-at->) #:processed #f #:canceled #f #:relationship (assq-ref opts 'relationship))) @@ -696,7 +711,14 @@ tags: (assq-ref opts 'ignore-if-build-required-by-another))) #:times 6 - #:delay 5))) + #:delay 5 + #:ignore + (lambda (exn) + (and (exception-with-message? exn) + (string=? + "build-already-canceled" + (assoc-ref (exception-message exn) + "error"))))))) (unless (string=? (assoc-ref result "result") "build-canceled") (simple-format #t "~A\n" @@ -795,7 +817,8 @@ tags: (let ((response (send-submit-build-request (assq-ref opts 'coordinator) - derivation-file + ;; Whitespace like \r can creep in here, so strip it + (string-trim-both derivation-file) (assq-ref opts 'derivation-substitute-urls) #f ; TODO requested uuid (assq-ref opts 'priority) @@ -1084,7 +1107,9 @@ tags: #:database-uri-string (assq-ref opts 'database) #:hooks hooks-with-defaults #:allocation-strategy - (assq-ref opts 'allocation-strategy)))) + (assq-ref opts 'allocation-strategy) + #:timestamp-log-output? + (assq-ref opts 'timestamp-log-output?)))) (parameterize ((%show-error-details (assoc-ref opts 'show-error-details))) @@ -1095,4 +1120,5 @@ tags: #:pid-file (assq-ref opts 'pid-file) #:agent-communication-uri (assq-ref opts 'agent-communication) #:client-communication-uri (assq-ref opts 'client-communication) - #:parallel-hooks (assq-ref opts 'parallel-hooks))))))) + #:parallel-hooks (assq-ref opts 'parallel-hooks) + #:listen-repl (assoc-ref opts 'listen-repl))))))) |