aboutsummaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
Diffstat (limited to 'scripts')
-rw-r--r--scripts/guix-build-coordinator.in88
1 files changed, 88 insertions, 0 deletions
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index a5e97bd..cb8c492 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -124,6 +124,51 @@
(ensure-all-related-derivation-outputs-have-builds . #f)
(tags . ())))
+(define %builds-list-options
+ (list (option '("tag") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'tags
+ (cons (match (string-split arg #\=)
+ ((key value) (cons key value)))
+ (or (assq-ref result 'tags)
+ '()))
+ (alist-delete 'tags result))))
+ (option '("not-tag") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'not-tags
+ (cons (match (string-split arg #\=)
+ ((key value) (cons key value)))
+ (or (assq-ref result 'not-tags)
+ '()))
+ (alist-delete 'not-tags result))))
+ (option '("processed") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'processed
+ (string=? arg "true")
+ result)))
+ (option '("canceled") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'canceled
+ (string=? arg "true")
+ result)))
+ (option '("after-id") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'after-id
+ arg
+ result)))
+ (option '("limit") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'limit
+ (string->number arg)
+ result)))))
+
+(define %builds-list-option-defaults
+ `((tags . ())
+ (not-tags . ())
+ (processed . 'unset)
+ (canceled . 'unset)
+ (limit . 1000)))
+
(define %service-options
(list (option '("pid-file") #t #f
(lambda (opt name arg result)
@@ -299,6 +344,49 @@ canceled?: ~A
build-id)))
(display-build `(("uuid" . ,build-id)
,@response)))))))
+ (("build" "list" rest ...)
+ (let ((opts (parse-options (append %base-options
+ %client-options
+ %builds-list-options)
+ (append %base-option-defaults
+ %client-option-defaults
+ %builds-list-option-defaults)
+ rest)))
+ (let ((response (request-builds-list
+ (assq-ref opts 'coordinator)
+ #:tags (assq-ref opts 'tags)
+ #:not-tags (assq-ref opts 'not-tags)
+ #:processed (assq-ref opts 'processed)
+ #:canceled (assq-ref opts 'canceled)
+ #:after-id (assq-ref opts 'after-id)
+ #:limit (assq-ref opts 'limit))))
+ (for-each
+ (lambda (build-details)
+ (simple-format (current-output-port)
+ "id: ~A
+derivation: ~A
+processed: ~A
+canceled: ~A
+priority: ~A
+tags:
+~A
+\n"
+ (assoc-ref build-details "uuid")
+ (assoc-ref build-details "derivation-name")
+ (if (assoc-ref build-details "processed")
+ "true"
+ "false")
+ (if (assoc-ref build-details "canceled")
+ "true"
+ "false")
+ (assoc-ref build-details "priority")
+ (string-join
+ (map (match-lambda
+ ((key . val)
+ (string-append " " key ": " val)))
+ (assoc-ref build-details "tags"))
+ "\n")))
+ (vector->list (assoc-ref response "builds"))))))
(("build" "show-blocking" rest ...)
(let ((opts (parse-options %base-options
(append %base-option-defaults