aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix-data-service/builds.scm10
-rw-r--r--scripts/guix-data-service-query-build-servers.in40
2 files changed, 42 insertions, 8 deletions
diff --git a/guix-data-service/builds.scm b/guix-data-service/builds.scm
index be9f421..1a1c7bb 100644
--- a/guix-data-service/builds.scm
+++ b/guix-data-service/builds.scm
@@ -17,15 +17,17 @@
#:use-module (guix-data-service model nar)
#:export (query-build-servers))
-(define (query-build-servers conn revision-commits)
+(define (query-build-servers conn build-server-ids revision-commits)
(while #t
(let ((build-servers (select-build-servers conn)))
(for-each
(match-lambda
((id url lookup-all-derivations?)
- (when lookup-all-derivations?
- (simple-format #t "\nQuerying ~A\n" url)
- (query-build-server conn id url revision-commits))))
+ (when (or (not build-servers)
+ (member id build-server-ids))
+ (when lookup-all-derivations?
+ (simple-format #t "\nQuerying ~A\n" url)
+ (query-build-server conn id url revision-commits)))))
build-servers))))
(define (query-build-server conn id url revision-commits)
diff --git a/scripts/guix-data-service-query-build-servers.in b/scripts/guix-data-service-query-build-servers.in
index aa66a9f..9ef8347 100644
--- a/scripts/guix-data-service-query-build-servers.in
+++ b/scripts/guix-data-service-query-build-servers.in
@@ -26,7 +26,39 @@
(guix-data-service database)
(guix-data-service builds))
-(with-postgresql-connection
- "query-build-servers"
- (lambda (conn)
- (query-build-servers conn (cdr (command-line)))))
+(define %options
+ ;; Specifications of the command-line options
+ (list (option '("build-server-id") #t #f
+ (lambda (opt name arg result)
+ (alist-cons
+ 'build-server-ids
+ (cons (string->number arg)
+ (or (assoc-ref result 'build-server-ids)
+ '()))
+ (alist-delete 'build-server-ids result))))))
+
+(define %default-options
+ ;; Alist of default option values
+ '())
+
+(define (parse-options args)
+ (args-fold
+ args %options
+ (lambda (opt name arg result)
+ (error "unrecognized option" name))
+ (lambda (arg result)
+ (alist-cons
+ 'revision-commits
+ (cons arg
+ (or (assoc-ref result 'revision-commits)
+ '()))
+ (alist-delete 'revision-commits result)))
+ %default-options))
+
+(let ((opts (parse-options (cdr (program-arguments)))))
+ (with-postgresql-connection
+ "query-build-servers"
+ (lambda (conn)
+ (query-build-servers conn
+ (assq-ref opts 'build-server-ids)
+ (assq-ref opts 'revision-commits)))))