Increase parallelism when loading revisions
This commit is contained in:
parent
f1071cbd4d
commit
b6551842d1
1 changed files with 229 additions and 191 deletions
|
|
@ -107,7 +107,7 @@
|
|||
missing-store-item-error?
|
||||
(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
|
||||
(lambda (exn)
|
||||
(if (missing-store-item-error? exn)
|
||||
|
|
@ -116,6 +116,7 @@
|
|||
"missing store item ~A, retrying ~A\n"
|
||||
(missing-store-item-error-item exn)
|
||||
thunk)
|
||||
(when on-exception (on-exception))
|
||||
(retry-on-missing-store-item thunk))
|
||||
(raise-exception exn)))
|
||||
thunk
|
||||
|
|
@ -1691,7 +1692,8 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
|
|||
|
||||
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-derivation
|
||||
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)))
|
||||
(with-resource-from-pool postgresql-connection-pool conn
|
||||
(insert-guix-revision-lint-checkers conn
|
||||
guix-revision-id
|
||||
(insert-guix-revision-lint-checkers
|
||||
conn
|
||||
(fibers-force guix-revision-id-promise)
|
||||
lint-checker-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)))
|
||||
(chunk-for-each!
|
||||
(lambda (lint-warning-ids-chunk)
|
||||
(insert-guix-revision-lint-warnings conn
|
||||
guix-revision-id
|
||||
(insert-guix-revision-lint-warnings
|
||||
conn
|
||||
(fibers-force guix-revision-id-promise)
|
||||
lint-warning-ids-chunk))
|
||||
5000
|
||||
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 (process-system-and-target system target)
|
||||
(with-time-logging
|
||||
(simple-format #f "processing derivations for ~A" (cons system target))
|
||||
(define (get-derivations system target)
|
||||
(let ((derivations-vector (make-vector packages-count)))
|
||||
(with-time-logging
|
||||
(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)
|
||||
(unless (>= (+ start-index chunk-size) packages-count)
|
||||
(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
|
||||
(simple-format #f "derivation-file-names->derivation-ids (~A ~A)"
|
||||
system target)
|
||||
(derivation-file-names->derivation-ids/fiberized
|
||||
derivations-vector))))
|
||||
|
||||
(let* ((package-ids (fibers-force package-ids-promise))
|
||||
derivations-vector)))
|
||||
(guix-revision-id
|
||||
(fibers-force guix-revision-id-promise))
|
||||
(package-ids (fibers-force package-ids-promise))
|
||||
(package-derivation-ids
|
||||
(with-resource-from-pool postgresql-connection-pool conn
|
||||
(with-time-logging
|
||||
|
|
@ -1968,7 +1976,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
|
|||
guix-revision-id
|
||||
package-derivation-ids-chunk)))
|
||||
2000
|
||||
package-derivation-ids)))))
|
||||
package-derivation-ids)))
|
||||
|
||||
(with-resource-from-pool postgresql-connection-pool conn
|
||||
(with-time-logging
|
||||
|
|
@ -1977,20 +1985,21 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
|
|||
system target)
|
||||
(insert-guix-revision-package-derivation-distribution-counts
|
||||
conn
|
||||
guix-revision-id
|
||||
(fibers-force guix-revision-id-promise)
|
||||
(number->string
|
||||
(system->system-id conn system))
|
||||
(or target "")))))
|
||||
|
||||
(let ((process-system-and-target/fiberized
|
||||
(fiberize process-system-and-target
|
||||
(let ((get-derivations/fiberized
|
||||
(fiberize get-derivations
|
||||
#:parallelism parallelism)))
|
||||
(par-map&
|
||||
(match-lambda
|
||||
((system . target)
|
||||
(retry-on-missing-store-item
|
||||
(lambda ()
|
||||
(process-system-and-target/fiberized system target)))))
|
||||
(process-system-and-target system target
|
||||
get-derivations/fiberized)))))
|
||||
(call-with-inferior
|
||||
(lambda (inferior inferior-store)
|
||||
(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
|
||||
(insert-system-tests-for-guix-revision
|
||||
conn
|
||||
guix-revision-id
|
||||
(fibers-force guix-revision-id-promise)
|
||||
data-with-derivation-ids)))))))
|
||||
|
||||
(with-time-logging
|
||||
|
|
@ -2124,34 +2133,48 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
|
|||
(channel-for-commit
|
||||
(channel (name 'guix)
|
||||
(url git-repository-url)
|
||||
(commit commit)))
|
||||
(guix-source
|
||||
channel-derivations-by-system
|
||||
guix-revision-id
|
||||
(retry-on-missing-store-item
|
||||
(commit commit))))
|
||||
|
||||
(define channel-derivations-by-system-promise
|
||||
(fibers-delay
|
||||
(lambda ()
|
||||
(let ((guix-source
|
||||
channel-derivations-by-system
|
||||
(channel->source-and-derivations-by-system
|
||||
conn
|
||||
channel-for-commit
|
||||
fetch-with-authentication?
|
||||
#:parallelism parallelism)))
|
||||
(let ((guix-revision-id
|
||||
#:parallelism parallelism))))
|
||||
|
||||
(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
|
||||
git-repository-id commit
|
||||
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
|
||||
guix-revision-id)))))))
|
||||
(let ((store-item
|
||||
(fibers-force channel-derivations-by-system-promise))
|
||||
(store-item
|
||||
guix-derivation
|
||||
(channel-derivations-by-system->guix-store-item
|
||||
channel-derivations-by-system)))
|
||||
(if store-item
|
||||
(and
|
||||
(extract-information-from conn
|
||||
guix-revision-id
|
||||
guix-revision-id-promise
|
||||
commit guix-source store-item
|
||||
guix-derivation
|
||||
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"
|
||||
(insert-channel-news-entries-for-guix-revision
|
||||
conn
|
||||
guix-revision-id
|
||||
(fibers-force guix-revision-id-promise)
|
||||
(channel-news-for-commit channel-for-commit commit)))
|
||||
(begin
|
||||
(simple-format
|
||||
#t "debug: importing channel news not supported\n")
|
||||
#t))
|
||||
|
||||
(update-package-derivations-table conn
|
||||
(update-package-derivations-table
|
||||
conn
|
||||
git-repository-id
|
||||
guix-revision-id
|
||||
(fibers-force guix-revision-id-promise)
|
||||
commit)
|
||||
(with-time-logging "updating builds.derivation_output_details_set_id"
|
||||
(update-builds-derivation-output-details-set-id
|
||||
conn
|
||||
(string->number guix-revision-id))))
|
||||
(string->number (fibers-force guix-revision-id-promise)))))
|
||||
(begin
|
||||
(simple-format #t "Failed to generate store item for ~A\n"
|
||||
commit)
|
||||
|
|
@ -2572,6 +2596,7 @@ SKIP LOCKED")
|
|||
(define* (process-load-new-guix-revision-job id #:key skip-system-tests?
|
||||
extra-inferior-environment-variables
|
||||
parallelism)
|
||||
(define result
|
||||
(with-postgresql-connection
|
||||
(simple-format #f "load-new-guix-revision ~A" id)
|
||||
(lambda (conn)
|
||||
|
|
@ -2639,10 +2664,29 @@ SKIP LOCKED")
|
|||
(record-job-event conn id "success")
|
||||
(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
|
||||
"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
|
||||
"vacuum-derivation-inputs-table"
|
||||
(vacuum-derivation-inputs-table conn))
|
||||
|
|
@ -2658,23 +2702,17 @@ SKIP LOCKED")
|
|||
1000000000)
|
||||
(with-time-logging
|
||||
"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
|
||||
"vacuum-derivation-outputs-table"
|
||||
(vacuum-derivation-outputs-table conn))
|
||||
|
||||
(with-time-logging
|
||||
"update-derivation-outputs-statistics"
|
||||
(update-derivation-outputs-statistics conn))
|
||||
(update-derivation-outputs-statistics conn))))))
|
||||
|
||||
#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))))))
|
||||
result)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue