cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Switch to processing jobs in parallel

Browse source 
This should speed up processing new revisions, reduce latency between finding
out about new revisions and processing them, as well as help manage memory
usage, by processing each job in a process that then exits.
This commit is contained in:
Christopher Baines 2019-07-12 19:58:37 +01:00
parent 09d927cb99
commit 83ef624b97
3 changed files with 194 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

100
guix-data-service/jobs.scm
View file

@ -1,11 +1,103 @@
(define-module (guix-data-service jobs) (define-module (guix-data-service jobs)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (guix-data-service jobs load-new-guix-revision) #:use-module (guix-data-service jobs load-new-guix-revision)
#:export (process-jobs)) #:export (process-jobs))
(define (process-jobs conn) (define (process-jobs conn)
(define (fetch-new-jobs)
(fetch-unlocked-jobs conn))
(define (process-job job-id)
(execlp "guix-data-service-process-job"
"guix-data-service-process-job"
job-id))
(process-jobs-concurrently fetch-new-jobs
process-job))
(define default-max-processes
(max (round (/ (current-processor-count)
4))
1))
(define* (process-jobs-concurrently fetch-new-jobs
process-job
#:key (max-processes
default-max-processes))
(define processes
(make-hash-table))
(define (display-status)
(display
(string-append
"\n\n"
(let ((running-jobs (hash-count (const #t) processes)))
(cond
((eq? running-jobs 0)
"status: 0 running jobs")
((eq? running-jobs 1)
"status: 1 running job")
(else
(simple-format #f "status: ~A running jobs"
running-jobs))))
"\n"
(string-concatenate
(hash-map->list
(lambda (pid job-args)
(format #f " pid: ~5d job args: ~a\n"
pid job-args))
processes))
"\n")))
(define (wait-on-processes)
(catch
#t
(lambda ()
(match (waitpid WAIT_ANY WNOHANG)
((0 . status)
;; No process to wait for
#f)
((pid . status)
(let ((job-args (hashv-ref processes pid)))
(hashv-remove! processes pid)
(simple-format
(current-error-port)
"pid ~A failed with status ~A\n"
pid status))
(wait-on-processes))))
(lambda (key . args)
(simple-format #t "key ~A args ~A\n"
key args))))
(define (fork-and-process-job job-args)
(match (primitive-fork)
(0
(dynamic-wind
(const #t)
(lambda ()
(apply process-job job-args))
(lambda ()
(primitive-exit 127))))
(pid
(hashv-set! processes pid job-args)
#t)))
(while #t (while #t
(match (process-next-load-new-guix-revision-job conn) (wait-on-processes)
(#f (unless (eq? 0 (sleep 5)) (display-status)
(exit 0))) (match (fetch-new-jobs)
(_ (simple-format #t "\nFinished processing job\n\n"))))) (()
;; Nothing to do
#f)
((jobs ...)
(for-each
(lambda (job-args)
(let ((current-processes
(hash-count (const #t) processes)))
(when (< current-processes
max-processes)
(fork-and-process-job job-args))))
jobs)))
(unless (eq? 0 (sleep 15))
(exit 0))))

121
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -24,7 +24,8 @@
#:use-module (guix-data-service model package-metadata) #:use-module (guix-data-service model package-metadata)
#:use-module (guix-data-service model derivation) #:use-module (guix-data-service model derivation)
#:export (log-for-job #:export (log-for-job
process-next-load-new-guix-revision-job fetch-unlocked-jobs
process-load-new-guix-revision-job
select-job-for-commit select-job-for-commit
select-jobs-and-events select-jobs-and-events
enqueue-load-new-guix-revision-job enqueue-load-new-guix-revision-job
@ -671,18 +672,20 @@ ORDER BY load_new_guix_revision_jobs.id DESC")
(list (number->string n))))) (list (number->string n)))))
result)) result))
(define (select-next-job-to-process conn) (define (select-job-for-update conn id)
(exec-query (exec-query
conn conn
(string-append (string-append
"SELECT id, commit, source, git_repository_id " "SELECT id, commit, source, git_repository_id "
"FROM load_new_guix_revision_jobs " "FROM load_new_guix_revision_jobs "
"WHERE succeeded_at IS NULL AND NOT EXISTS (" "WHERE id = $1 AND succeeded_at IS NULL AND NOT EXISTS ("
"SELECT 1 " "SELECT 1 "
"FROM load_new_guix_revision_job_events " "FROM load_new_guix_revision_job_events "
;; Skip jobs that have failed, to avoid trying them over and over again ;; Skip jobs that have failed, to avoid trying them over and over again
"WHERE job_id = load_new_guix_revision_jobs.id AND event = 'failure'" "WHERE job_id = load_new_guix_revision_jobs.id AND event = 'failure'"
") ORDER BY id DESC LIMIT 1"))) ") ORDER BY id DESC "
"FOR NO KEY UPDATE SKIP LOCKED")
(list id)))
(define (record-job-event conn job-id event) (define (record-job-event conn job-id event)
(exec-query (exec-query
@ -701,43 +704,73 @@ ORDER BY load_new_guix_revision_jobs.id DESC")
"WHERE id = $1 ") "WHERE id = $1 ")
(list id))) (list id)))
(define (process-next-load-new-guix-revision-job conn) (define (fetch-unlocked-jobs conn)
(match (select-next-job-to-process conn) (exec-query
(((id commit source git-repository-id)) conn
(let ((previous-output-port (current-output-port)) "
(previous-error-port (current-error-port))) SELECT id FROM load_new_guix_revision_jobs
(record-job-event conn id "start") WHERE
(simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n" succeeded_at IS NULL AND
id commit source) NOT EXISTS (
(exec-query conn "BEGIN") SELECT 1
(if (or (guix-revision-exists? conn git-repository-id commit) FROM load_new_guix_revision_job_events
(eq? (log-time -- Skip jobs that have failed, to avoid trying them over and over again
(string-append "loading revision " commit) WHERE job_id = load_new_guix_revision_jobs.id AND event = 'failure'
(lambda () )
(let ((result ORDER BY id DESC
(with-postgresql-connection FOR NO KEY UPDATE SKIP LOCKED"))
(simple-format #f "load-new-guix-revision ~A logging" id)
(lambda (logging-conn) (define (process-load-new-guix-revision-job id)
(insert-empty-log-entry logging-conn id) (with-postgresql-connection
(let ((logging-port (log-port id logging-conn))) (simple-format #f "load-new-guix-revision ~A" id)
(set-current-output-port logging-port) (lambda (conn)
(set-current-error-port logging-port) (exec-query conn "BEGIN")
(let ((result
(parameterize ((current-build-output-port logging-port)) (match (select-job-for-update conn id)
(load-new-guix-revision conn git-repository-id commit)))) (((id commit source git-repository-id))
(combine-log-parts! logging-conn id)
result)))))) ;; With a separate connection, outside of the transaction so the event
(set-current-output-port previous-output-port) ;; gets persisted regardless.
(set-current-error-port previous-error-port) (with-postgresql-connection
result))) (simple-format #f "load-new-guix-revision ~A start-event" id)
#t)) (lambda (start-event-conn)
(begin (record-job-event start-event-conn id "start")))
(record-job-succeeded conn id)
(record-job-event conn id "success") (simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n"
(exec-query conn "COMMIT") id commit source)
#t)
(begin (if (or (guix-revision-exists? conn git-repository-id commit)
(exec-query conn "ROLLBACK") (eq? (log-time
(record-job-event conn id "failure") (string-append "loading revision " commit)
#f)))) (lambda ()
(_ #f))) (let* ((previous-output-port (current-output-port))
(previous-error-port (current-error-port))
(result
(with-postgresql-connection
(simple-format #f "load-new-guix-revision ~A logging" id)
(lambda (logging-conn)
(insert-empty-log-entry logging-conn id)
(let ((logging-port (log-port id logging-conn)))
(set-current-output-port logging-port)
(set-current-error-port logging-port)
(let ((result
(parameterize ((current-build-output-port logging-port))
(load-new-guix-revision conn git-repository-id commit))))
(combine-log-parts! logging-conn id)
result))))))
(set-current-output-port previous-output-port)
(set-current-error-port previous-error-port)
result)))
#t))
(begin
(record-job-succeeded conn id)
(record-job-event conn id "success")
(exec-query conn "COMMIT")
#t)
(begin
(exec-query conn "ROLLBACK")
(record-job-event conn id "failure")
#f)))
(()
(simple-format #t "job ~A not found to be processed\n"
id))))))

42
tests/jobs-load-new-guix-revision.scm
View file

@ -32,13 +32,13 @@
(lambda (conn git-repository-id commit store-path) (lambda (conn git-repository-id commit store-path)
#t)) #t))
(enqueue-load-new-guix-revision-job (match (enqueue-load-new-guix-revision-job
conn conn
(git-repository-url->git-repository-id conn "test-url") (git-repository-url->git-repository-id conn "test-url")
"test-commit" "test-commit"
"test-source") "test-source")
((id)
(process-next-load-new-guix-revision-job conn)))) (process-load-new-guix-revision-job id))))))
(test-equal "test build store item failure" (test-equal "test build store item failure"
#f #f
@ -48,13 +48,13 @@
(lambda (conn git-repository-id commit) (lambda (conn git-repository-id commit)
#f)) #f))
(enqueue-load-new-guix-revision-job (match (enqueue-load-new-guix-revision-job
conn conn
(git-repository-url->git-repository-id conn "test-url") (git-repository-url->git-repository-id conn "test-url")
"test-commit" "test-commit"
"test-source") "test-source")
((id)
(process-next-load-new-guix-revision-job conn))) (process-load-new-guix-revision-job id)))))
(test-equal "test extract information failure" (test-equal "test extract information failure"
#f #f
@ -70,12 +70,12 @@
(lambda (conn git-repository-id commit store-path) (lambda (conn git-repository-id commit store-path)
#f)) #f))
(enqueue-load-new-guix-revision-job (match (enqueue-load-new-guix-revision-job
conn conn
(git-repository-url->git-repository-id conn "test-url") (git-repository-url->git-repository-id conn "test-url")
"test-commit" "test-commit"
"test-source") "test-source")
((id)
(process-next-load-new-guix-revision-job conn)))))) (process-load-new-guix-revision-job id))))))))
(test-end) (test-end)