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

Increase parallelism when loading revisions

Browse source
This commit is contained in:
Christopher Baines 2024-10-17 17:10:25 +02:00
parent f1071cbd4d
commit b6551842d1
1 changed files with 229 additions and 191 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -107,7 +107,7 @@
missing-store-item-error? missing-store-item-error?
(item missing-store-item-error-item)) (item missing-store-item-error-item))
(define (retry-on-missing-store-item thunk) (define* (retry-on-missing-store-item thunk #:key on-exception)
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
(if (missing-store-item-error? exn) (if (missing-store-item-error? exn)
@ -116,6 +116,7 @@
"missing store item ~A, retrying ~A\n" "missing store item ~A, retrying ~A\n"
(missing-store-item-error-item exn) (missing-store-item-error-item exn)
thunk) thunk)
(when on-exception (on-exception))
(retry-on-missing-store-item thunk)) (retry-on-missing-store-item thunk))
(raise-exception exn))) (raise-exception exn)))
thunk thunk
@ -1691,7 +1692,8 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
inf)))) inf))))
(define* (extract-information-from db-conn guix-revision-id commit (define* (extract-information-from db-conn guix-revision-id-promise
commit
guix-source store-item guix-source store-item
guix-derivation guix-derivation
utility-thread-channel utility-thread-channel
@ -1885,8 +1887,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(let ((package-ids (fibers-force package-ids-promise))) (let ((package-ids (fibers-force package-ids-promise)))
(with-resource-from-pool postgresql-connection-pool conn (with-resource-from-pool postgresql-connection-pool conn
(insert-guix-revision-lint-checkers conn (insert-guix-revision-lint-checkers
guix-revision-id conn
(fibers-force guix-revision-id-promise)
lint-checker-ids) lint-checker-ids)
(let ((lint-warning-ids (let ((lint-warning-ids
@ -1897,8 +1900,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
lint-warnings-data))) lint-warnings-data)))
(chunk-for-each! (chunk-for-each!
(lambda (lint-warning-ids-chunk) (lambda (lint-warning-ids-chunk)
(insert-guix-revision-lint-warnings conn (insert-guix-revision-lint-warnings
guix-revision-id conn
(fibers-force guix-revision-id-promise)
lint-warning-ids-chunk)) lint-warning-ids-chunk))
5000 5000
lint-warning-ids))))))) lint-warning-ids)))))))
@ -1913,9 +1917,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(define chunk-size 1000) (define chunk-size 1000)
(define (process-system-and-target system target) (define (get-derivations system target)
(with-time-logging
(simple-format #f "processing derivations for ~A" (cons system target))
(let ((derivations-vector (make-vector packages-count))) (let ((derivations-vector (make-vector packages-count)))
(with-time-logging (with-time-logging
(simple-format #f "getting derivations for ~A" (cons system target)) (simple-format #f "getting derivations for ~A" (cons system target))
@ -1941,15 +1943,21 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
chunk) chunk)
(unless (>= (+ start-index chunk-size) packages-count) (unless (>= (+ start-index chunk-size) packages-count)
(loop (+ start-index chunk-size)))))) (loop (+ start-index chunk-size))))))
derivations-vector))
(let* ((derivation-ids (define (process-system-and-target system target get-derivations)
(with-time-logging
(simple-format #f "processing derivations for ~A" (cons system target))
(let* ((derivations-vector (get-derivations system target))
(derivation-ids
(with-time-logging (with-time-logging
(simple-format #f "derivation-file-names->derivation-ids (~A ~A)" (simple-format #f "derivation-file-names->derivation-ids (~A ~A)"
system target) system target)
(derivation-file-names->derivation-ids/fiberized (derivation-file-names->derivation-ids/fiberized
derivations-vector)))) derivations-vector)))
(guix-revision-id
(let* ((package-ids (fibers-force package-ids-promise)) (fibers-force guix-revision-id-promise))
(package-ids (fibers-force package-ids-promise))
(package-derivation-ids (package-derivation-ids
(with-resource-from-pool postgresql-connection-pool conn (with-resource-from-pool postgresql-connection-pool conn
(with-time-logging (with-time-logging
@ -1968,7 +1976,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
guix-revision-id guix-revision-id
package-derivation-ids-chunk))) package-derivation-ids-chunk)))
2000 2000
package-derivation-ids))))) package-derivation-ids)))
(with-resource-from-pool postgresql-connection-pool conn (with-resource-from-pool postgresql-connection-pool conn
(with-time-logging (with-time-logging
@ -1977,20 +1985,21 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
system target) system target)
(insert-guix-revision-package-derivation-distribution-counts (insert-guix-revision-package-derivation-distribution-counts
conn conn
guix-revision-id (fibers-force guix-revision-id-promise)
(number->string (number->string
(system->system-id conn system)) (system->system-id conn system))
(or target ""))))) (or target "")))))
(let ((process-system-and-target/fiberized (let ((get-derivations/fiberized
(fiberize process-system-and-target (fiberize get-derivations
#:parallelism parallelism))) #:parallelism parallelism)))
(par-map& (par-map&
(match-lambda (match-lambda
((system . target) ((system . target)
(retry-on-missing-store-item (retry-on-missing-store-item
(lambda () (lambda ()
(process-system-and-target/fiberized system target))))) (process-system-and-target system target
get-derivations/fiberized)))))
(call-with-inferior (call-with-inferior
(lambda (inferior inferior-store) (lambda (inferior inferior-store)
(inferior-fetch-system-target-pairs inferior)))))) (inferior-fetch-system-target-pairs inferior))))))
@ -2027,7 +2036,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(with-resource-from-pool postgresql-connection-pool conn (with-resource-from-pool postgresql-connection-pool conn
(insert-system-tests-for-guix-revision (insert-system-tests-for-guix-revision
conn conn
guix-revision-id (fibers-force guix-revision-id-promise)
data-with-derivation-ids))))))) data-with-derivation-ids)))))))
(with-time-logging (with-time-logging
@ -2124,34 +2133,48 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(channel-for-commit (channel-for-commit
(channel (name 'guix) (channel (name 'guix)
(url git-repository-url) (url git-repository-url)
(commit commit))) (commit commit))))
(guix-source
channel-derivations-by-system (define channel-derivations-by-system-promise
guix-revision-id (fibers-delay
(retry-on-missing-store-item
(lambda () (lambda ()
(let ((guix-source
channel-derivations-by-system
(channel->source-and-derivations-by-system (channel->source-and-derivations-by-system
conn conn
channel-for-commit channel-for-commit
fetch-with-authentication? fetch-with-authentication?
#:parallelism parallelism))) #:parallelism parallelism))))
(let ((guix-revision-id
(define guix-revision-id-promise
(fibers-delay
(lambda ()
(retry-on-missing-store-item
(lambda ()
(let ((guix-source
channel-derivations-by-system
(fibers-force channel-derivations-by-system-promise)))
(load-channel-instances utility-thread-channel (load-channel-instances utility-thread-channel
git-repository-id commit git-repository-id commit
channel-derivations-by-system))) channel-derivations-by-system)))
(values guix-source #:on-exception
(lambda ()
(fibers-promise-reset channel-derivations-by-system-promise))))))
;; Prompt getting the guix-revision-id as soon as possible
(spawn-fiber
(lambda ()
(fibers-force guix-revision-id-promise)))
(let* ((guix-source
channel-derivations-by-system channel-derivations-by-system
guix-revision-id))))))) (fibers-force channel-derivations-by-system-promise))
(let ((store-item (store-item
guix-derivation guix-derivation
(channel-derivations-by-system->guix-store-item (channel-derivations-by-system->guix-store-item
channel-derivations-by-system))) channel-derivations-by-system)))
(if store-item (if store-item
(and (and
(extract-information-from conn (extract-information-from conn
guix-revision-id guix-revision-id-promise
commit guix-source store-item commit guix-source store-item
guix-derivation guix-derivation
utility-thread-channel utility-thread-channel
@ -2166,21 +2189,22 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(with-time-logging "inserting channel news entries" (with-time-logging "inserting channel news entries"
(insert-channel-news-entries-for-guix-revision (insert-channel-news-entries-for-guix-revision
conn conn
guix-revision-id (fibers-force guix-revision-id-promise)
(channel-news-for-commit channel-for-commit commit))) (channel-news-for-commit channel-for-commit commit)))
(begin (begin
(simple-format (simple-format
#t "debug: importing channel news not supported\n") #t "debug: importing channel news not supported\n")
#t)) #t))
(update-package-derivations-table conn (update-package-derivations-table
conn
git-repository-id git-repository-id
guix-revision-id (fibers-force guix-revision-id-promise)
commit) commit)
(with-time-logging "updating builds.derivation_output_details_set_id" (with-time-logging "updating builds.derivation_output_details_set_id"
(update-builds-derivation-output-details-set-id (update-builds-derivation-output-details-set-id
conn conn
(string->number guix-revision-id)))) (string->number (fibers-force guix-revision-id-promise)))))
(begin (begin
(simple-format #t "Failed to generate store item for ~A\n" (simple-format #t "Failed to generate store item for ~A\n"
commit) commit)
@ -2572,6 +2596,7 @@ SKIP LOCKED")
(define* (process-load-new-guix-revision-job id #:key skip-system-tests? (define* (process-load-new-guix-revision-job id #:key skip-system-tests?
extra-inferior-environment-variables extra-inferior-environment-variables
parallelism) parallelism)
(define result
(with-postgresql-connection (with-postgresql-connection
(simple-format #f "load-new-guix-revision ~A" id) (simple-format #f "load-new-guix-revision ~A" id)
(lambda (conn) (lambda (conn)
@ -2639,10 +2664,29 @@ SKIP LOCKED")
(record-job-event conn id "success") (record-job-event conn id "success")
(exec-query conn "COMMIT") (exec-query conn "COMMIT")
#t)
(begin
(exec-query conn "ROLLBACK")
(record-job-event conn id "failure")
#f)))
(()
(exec-query conn "ROLLBACK")
(simple-format #t "job ~A not found to be processed\n"
id))))))
(when result
(parallel-via-fibers
(with-postgresql-connection
(simple-format #f "post load-new-guix-revision ~A" id)
(lambda (conn)
(with-time-logging (with-time-logging
"vacuuming package derivations by guix revision range table" "vacuuming package derivations by guix revision range table"
(vacuum-package-derivations-table conn)) (vacuum-package-derivations-table conn))))
(with-postgresql-connection
(simple-format #f "post load-new-guix-revision ~A" id)
(lambda (conn)
(with-time-logging (with-time-logging
"vacuum-derivation-inputs-table" "vacuum-derivation-inputs-table"
(vacuum-derivation-inputs-table conn)) (vacuum-derivation-inputs-table conn))
@ -2658,23 +2702,17 @@ SKIP LOCKED")
1000000000) 1000000000)
(with-time-logging (with-time-logging
"update-derivation-inputs-statistics" "update-derivation-inputs-statistics"
(update-derivation-inputs-statistics conn))))) (update-derivation-inputs-statistics conn)))))))
(with-postgresql-connection
(simple-format #f "post load-new-guix-revision ~A" id)
(lambda (conn)
(with-time-logging (with-time-logging
"vacuum-derivation-outputs-table" "vacuum-derivation-outputs-table"
(vacuum-derivation-outputs-table conn)) (vacuum-derivation-outputs-table conn))
(with-time-logging (with-time-logging
"update-derivation-outputs-statistics" "update-derivation-outputs-statistics"
(update-derivation-outputs-statistics conn)) (update-derivation-outputs-statistics conn))))))
#t) result)
(begin
(exec-query conn "ROLLBACK")
(record-job-event conn id "failure")
#f)))
(()
(exec-query conn "ROLLBACK")
(simple-format #t "job ~A not found to be processed\n"
id))))))