aboutsummaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2020-04-09 21:35:15 +0100
committerChristopher Baines <mail@cbaines.net>2020-04-10 20:34:47 +0100
commit27c7e0dfe269627372100870b54a0381b6f26d03 (patch)
tree9a0ead9d93a066a8e70ec6839d141873b9c541ec /scripts
parent8d7fd9b7d761e5442aa4f429f8894ab047c98387 (diff)
downloadbuild-coordinator-27c7e0dfe269627372100870b54a0381b6f26d03.tar
build-coordinator-27c7e0dfe269627372100870b54a0381b6f26d03.tar.gz
Support creating agents
By running guix-build-coordinator agent new
Diffstat (limited to 'scripts')
-rw-r--r--scripts/guix-build-coordinator.in79
1 files changed, 56 insertions, 23 deletions
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index 5bf3d31..298c9fe 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -30,14 +30,9 @@
(guix-build-coordinator coordinator)
(guix-build-coordinator agent-messaging http))
-(define %options
+(define %base-options
;; Specifications of the command-line options
- (list (option '("pid-file") #t #f
- (lambda (opt name arg result)
- (alist-cons 'pid-file
- arg
- result)))
- (option '("secret-key-base-file") #t #f
+ (list (option '("secret-key-base-file") #t #f
(lambda (opt name arg result)
(alist-cons 'secret-key-base
(string-trim-right
@@ -51,21 +46,11 @@
(option '("update-database") #f #f
(lambda (opt name _ result)
(alist-cons 'update-database #t result)))
- (option '("port") #t #f
- (lambda (opt name arg result)
- (alist-cons 'port
- (string->number arg)
- (alist-delete 'port result))))
- (option '("host") #t #f
- (lambda (opt name arg result)
- (alist-cons 'host
- arg
- (alist-delete 'host result))))
(option '("show-error-details") #f #f
(lambda (opt name _ result)
(alist-cons 'show-error-details #t result)))))
-(define %default-options
+(define %base-option-defaults
;; Alist of default option values
`((update-database . #f)
(database . "sqlite://guix_build_coordinator.db")
@@ -77,9 +62,43 @@
("" #f)
(_ #t)))))
-(define (parse-options args)
+(define %service-options
+ (list (option '("pid-file") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'pid-file
+ arg
+ result)))
+ (option '("port") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'port
+ (string->number arg)
+ (alist-delete 'port result))))
+ (option '("host") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'host
+ arg
+ (alist-delete 'host result))))))
+
+(define %service-option-defaults
+ ;; Alist of default option values
+ `((port . 8745)
+ (host . "0.0.0.0")))
+
+(define %agent-options
+ (list (option '("uuid") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'uuid
+ arg
+ result)))
+ (option '("description") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'description
+ arg
+ result)))))
+
+(define (parse-options options defaults args)
(args-fold
- args %options
+ args options
(lambda (opt name arg result)
(error "unrecognized option" name))
(lambda (arg result)
@@ -89,14 +108,14 @@
(or (assoc-ref result 'arguments)
'()))
(alist-delete 'arguments result)))
- %default-options))
+ defaults))
(setvbuf (current-output-port) 'line)
(setvbuf (current-error-port) 'line)
(match (cdr (program-arguments))
(("build" rest ...)
- (let ((opts (parse-options rest)))
+ (let ((opts (parse-options %base-options %base-option-defaults rest)))
(match (assq-ref opts 'arguments)
((derivation-file)
@@ -106,8 +125,22 @@
(assq-ref opts 'database))
derivation-file)))
(simple-format #t "build submitted as ~A\n" uuid))))))
+ (("agent" "new" rest ...)
+ (let ((opts (parse-options (append %agent-options
+ %base-options)
+ %base-option-defaults
+ rest)))
+ (let ((uuid (new-agent (database-uri->datastore
+ (assq-ref opts 'database))
+ #:requested-uuid (assq-ref opts 'uuid)
+ #:description (assq-ref opts 'description))))
+ (simple-format #t "agent created as as ~A\n" uuid))))
((arguments ...)
- (let* ((opts (parse-options arguments))
+ (let* ((opts (parse-options (append %service-options
+ %base-options)
+ (append %service-option-defaults
+ %base-option-defaults)
+ arguments))
(datastore (database-uri->datastore
(assq-ref opts 'database))))