aboutsummaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-11-05 13:42:03 +0000
committerChristopher Baines <mail@cbaines.net>2023-11-05 13:46:20 +0000
commitc3cb04cb8052492dae715012586f9e3d2d64579d (patch)
tree1f56c415ef46e68d60d623e0a0bea70c4bd74ceb /scripts
parentf5acc60288e0ad9f0c1093f3d50af1347e4df1df (diff)
downloaddata-service-c3cb04cb8052492dae715012586f9e3d2d64579d.tar
data-service-c3cb04cb8052492dae715012586f9e3d2d64579d.tar.gz
Use fibers when processing new revisions
Just have one fiber at the moment, but this will enable using fibers for parallelism in the future. Fibers seemed to cause problems with the logging setup, which was a bit odd in the first place. So move logging to the parent process which is better anyway.
Diffstat (limited to 'scripts')
-rw-r--r--scripts/guix-data-service-process-job.in26
1 files changed, 21 insertions, 5 deletions
diff --git a/scripts/guix-data-service-process-job.in b/scripts/guix-data-service-process-job.in
index c6d06c6..89e31b9 100644
--- a/scripts/guix-data-service-process-job.in
+++ b/scripts/guix-data-service-process-job.in
@@ -25,6 +25,8 @@
(use-modules (srfi srfi-1)
(srfi srfi-37)
(ice-9 match)
+ (ice-9 suspendable-ports)
+ (fibers)
(guix-data-service database)
(guix-data-service data-deletion)
(guix-data-service model package-derivation-by-guix-revision-range)
@@ -38,12 +40,21 @@
;; Make stack traces more useful
(setenv "COLUMNS" "256")
+(install-suspendable-ports!)
+
(define %options
(list (option '("skip-system-tests") #f #f
(lambda (opt name _ result)
- (alist-cons 'skip-system-tests #t result)))))
+ (alist-cons 'skip-system-tests #t result)))
+ (option '("parallelism") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'parallelism
+ (string->number arg)
+ (alist-delete 'parallelism
+ result))))))
-(define %default-options '())
+(define %default-options
+ '((parallelism . 1)))
(define (parse-options args)
(args-fold
@@ -62,6 +73,11 @@
(let ((opts (parse-options (cdr (program-arguments)))))
(match (assq-ref opts 'arguments)
((job)
- (process-load-new-guix-revision-job
- job
- #:skip-system-tests? (assq-ref opts 'skip-system-tests)))))
+ (run-fibers
+ (lambda ()
+ (process-load-new-guix-revision-job
+ job
+ #:skip-system-tests? (assq-ref opts 'skip-system-tests)))
+ #:hz 0
+ #:parallelism (assq-ref opts 'parallelism)
+ #:drain? #t))))