diff options
| -rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 23 | ||||
| -rw-r--r-- | guix-qa-frontpage/server.scm | 48 | ||||
| -rw-r--r-- | scripts/guix-qa-frontpage.in | 12 |
3 files changed, 57 insertions, 26 deletions
diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm index 15d0a2f..3d5e917 100644 --- a/guix-qa-frontpage/manage-builds.scm +++ b/guix-qa-frontpage/manage-builds.scm @@ -5,6 +5,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 streams) #:use-module (ice-9 threads) + #:use-module (fibers) #:use-module (prometheus) #:use-module (guix sets) #:use-module ((guix build syscalls) @@ -27,7 +28,7 @@ default-branch-priority-for-change submit-builds-for-branch - start-submit-patch-builds-thread + start-submit-patch-builds-fiber start-submit-branch-builds-thread start-submit-master-branch-system-tests-thread)) @@ -116,11 +117,11 @@ (simple-format #t "no derivation changes url for issue ~A\n" issue-number)))) -(define* (start-submit-patch-builds-thread database - build-coordinator - guix-data-service - metrics-registry - #:key (series-count 200)) +(define* (start-submit-patch-builds-fiber database + build-coordinator + guix-data-service + metrics-registry + #:key (series-count 200)) (define (priority-for-change change) (if (member (assoc-ref change "system") '("x86_64-linux" "aarch64-linux")) @@ -162,8 +163,7 @@ issues-with-builds-to-cancel)) (simple-format #t "submitting patch builds\n") - (n-par-for-each - 4 + (for-each (lambda (issue-number) (submit-builds-for-issue database @@ -176,13 +176,8 @@ 300))) first-n-series-issue-numbers))) - (call-with-new-thread + (spawn-fiber (lambda () - (catch 'system-error - (lambda () - (set-thread-name "patch builds")) - (const #t)) - (while #t (with-exception-handler (lambda (exn) diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index 0f2f40f..4b7bfeb 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -30,8 +30,11 @@ #:use-module (prometheus) #:use-module (system repl error-handling) #:use-module (fibers) + #:use-module (fibers scheduler) #:use-module (fibers conditions) #:use-module (guix store) + #:use-module ((guix build syscalls) + #:select (set-thread-name)) #:use-module (guix-data-service web util) #:use-module ((guix-data-service web query-parameters) #:select (parse-query-string)) @@ -57,7 +60,7 @@ #:use-module (guix-qa-frontpage view branches) #:use-module (guix-qa-frontpage view branch) #:use-module (guix-qa-frontpage view issue) - #:export (start-guix-qa-frontpage-web-server)) + #:export (start-guix-qa-frontpage)) (define (branch-for-issue database issue-number) (let ((branches @@ -535,18 +538,55 @@ has no patches or has been closed.") (render-html #:sxml (error-page args) #:code 500)))) -(define* (start-guix-qa-frontpage-web-server port host assets-directory - database metrics-registry - #:key (controller-args '())) +(define* (start-guix-qa-frontpage port host assets-directory + database metrics-registry + #:key (controller-args '()) + submit-builds? + patch-issues-to-show) (define controller (apply make-controller assets-directory database metrics-registry controller-args)) (let ((finished? (make-condition))) + (call-with-new-thread + (lambda () + (catch 'system-error + (lambda () + (set-thread-name "maintenance")) + (const #t)) + + (run-fibers + (lambda () + (when submit-builds? + (start-submit-patch-builds-fiber database + "http://127.0.0.1:8746" + "https://data.qa.guix.gnu.org" + metrics-registry + #:series-count + patch-issues-to-show)) + (wait finished?)) + #:parallelism 1))) + (call-with-sigint (lambda () (run-fibers (lambda () + (let* ((current (current-scheduler)) + (schedulers + (cons current (scheduler-remote-peers current)))) + (for-each + (lambda (i sched) + (spawn-fiber + (lambda () + (catch 'system-error + (lambda () + (set-thread-name + (string-append "fibers " (number->string i)))) + (const #t))) + sched)) + (iota (length schedulers)) + schedulers)) + (run-server/patched (lambda (request body) (apply values (handler request body controller))) diff --git a/scripts/guix-qa-frontpage.in b/scripts/guix-qa-frontpage.in index c57d14d..3368860 100644 --- a/scripts/guix-qa-frontpage.in +++ b/scripts/guix-qa-frontpage.in @@ -254,12 +254,6 @@ metrics-registry) (when (assq-ref opts 'submit-builds) - (start-submit-patch-builds-thread database - "http://127.0.0.1:8746" - "https://data.qa.guix.gnu.org" - metrics-registry - #:series-count - patch-issues-to-show) (start-submit-branch-builds-thread database "http://127.0.0.1:8746" "https://data.qa.guix.gnu.org" @@ -274,11 +268,13 @@ (start-manage-patch-branches-thread database #:series-count patch-issues-to-show)) - (start-guix-qa-frontpage-web-server + (start-guix-qa-frontpage (assq-ref opts 'port) (assq-ref opts 'host) (assq-ref opts 'assets-directory) database metrics-registry #:controller-args `(#:doc-dir ,doc-dir - #:patch-issues-to-show ,patch-issues-to-show))))))) + #:patch-issues-to-show ,patch-issues-to-show) + #:submit-builds? (assq-ref opts 'submit-builds) + #:patch-issues-to-show patch-issues-to-show)))))) |