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

Hopefully speed up the new guix revision processing

Browse source 
Compute all derivations at once in the inferior, avoiding round trips
to hopefully speed it up. Close the inferior earlier to free up
memory, and add more debugging output.
This commit is contained in:
Christopher Baines 2019-03-13 09:24:47 +00:00
parent e117bb1d87
commit a0dd298239
Signed by: cbaines
GPG key ID: 5E28A33B0B84F577
1 changed files with 105 additions and 96 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,6 +1,7 @@
(define-module (guix-data-service jobs load-new-guix-revision) (define-module (guix-data-service jobs load-new-guix-revision)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 hash-table)
#:use-module (squee) #:use-module (squee)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix store) #:use-module (guix store)
@ -21,85 +22,85 @@
select-job-for-commit select-job-for-commit
most-recent-n-load-new-guix-revision-jobs)) most-recent-n-load-new-guix-revision-jobs))
(define (inferior-guix->package-derivation-ids store conn inf) (define inferior-package-id
(define (inferior-package->systems-targets-and-derivations package) (@@ (guix inferior) inferior-package-id))
(let ((supported-systems
(inferior-package-transitive-supported-systems package))) (define (all-inferior-package-derivations store inf packages)
(define proc
`(lambda (store)
(append-map
(lambda (inferior-package-id)
(let* ((package
(hashv-ref %package-table inferior-package-id))
(supported-systems
(package-transitive-supported-systems package)))
(append-map (append-map
(lambda (system) (lambda (system)
(filter-map (filter-map
(lambda (target) (lambda (target)
(catch (catch
#t 'misc-error
(lambda () (lambda ()
(list (guard (c ((package-cross-build-system-error? c)
#f))
(list inferior-package-id
system system
target target
(inferior-package-derivation store package system (derivation-file-name
#:target
(if (string=? system target) (if (string=? system target)
#f (package-derivation store package system)
target)))) (package-cross-derivation store package
target
system))))))
(lambda args (lambda args
(cond #f)))
((string-contains (simple-format #f "~A" (second args))
"&package-cross-build-system-error")
#f)
((string-contains (simple-format #f "~A" (fourth args))
"(No cross-compilation for ")
#f)
(else
(simple-format
#t "guix-data-service: inferior-guix->package-ids: error processing derivation\n ~A for system ~A and target ~A\n"
package system target)
(for-each (lambda (arg)
(simple-format #t "arg: ~A\n" arg))
args)
#f)))))
supported-systems)) supported-systems))
supported-systems))) supported-systems)))
(list ,@(map inferior-package-id packages)))))
(inferior-eval-with-store inf store proc))
(define (inferior-guix->package-derivation-ids store conn inf)
(let* ((packages (inferior-packages inf)) (let* ((packages (inferior-packages inf))
(packages-metadata-ids (packages-metadata-ids
(inferior-packages->package-metadata-ids conn packages)) (inferior-packages->package-metadata-ids conn packages))
(packages-count (length packages))
(progress-reporter (progress-reporter/bar
packages-count
(format #f "processing ~a packages"
packages-count)))
(systems-targets-and-derivations-by-package
(call-with-progress-reporter progress-reporter
(lambda (report)
(map
(lambda (package)
(report)
(inferior-package->systems-targets-and-derivations package))
packages))))
(package-ids (package-ids
(inferior-packages->package-ids (inferior-packages->package-ids
conn packages packages-metadata-ids)) conn packages packages-metadata-ids))
(derivation-ids (inferior-package-id->package-id-hash-table
(alist->hashq-table
(map (lambda (package package-id)
(cons (inferior-package-id package)
package-id))
packages
package-ids)))
(inferior-data-4-tuples
(all-inferior-package-derivations store inf packages)))
(simple-format
#t "debug: finished loading information from inferior\n")
(close-inferior inf)
(let ((derivation-ids
(derivations->derivation-ids (derivations->derivation-ids
conn conn
(append-map (map (lambda (tuple)
(lambda (system-targets-and-derivations) (read-derivation-from-file
(map third system-targets-and-derivations)) (fourth tuple)))
systems-targets-and-derivations-by-package))) inferior-data-4-tuples)))
(flat-package-ids-systems-and-targets (flat-package-ids-systems-and-targets
(append-map (map
(lambda (package-id system-targets-and-derivations) (match-lambda
(map (match-lambda ((inferior-package-id system target derivation-file-name)
((system target derivation) (list (hashq-ref inferior-package-id->package-id-hash-table
(list package-id inferior-package-id)
system system
target))) target)))
system-targets-and-derivations)) inferior-data-4-tuples)))
package-ids
systems-targets-and-derivations-by-package)))
(insert-package-derivations conn (insert-package-derivations conn
flat-package-ids-systems-and-targets flat-package-ids-systems-and-targets
derivation-ids))) derivation-ids))))
(define (inferior-package-transitive-supported-systems package) (define (inferior-package-transitive-supported-systems package)
((@@ (guix inferior) inferior-package-field) ((@@ (guix inferior) inferior-package-field)
@ -154,6 +155,7 @@
(@@ (guix channels) channel-instance)) (@@ (guix channels) channel-instance))
inferior) inferior)
(let ((file-name
(inferior-eval-with-store (inferior-eval-with-store
inferior inferior
store store
@ -171,7 +173,11 @@
(mlet* %store-monad ((manifest (channel-instances->manifest instances)) (mlet* %store-monad ((manifest (channel-instances->manifest instances))
(derv (profile-derivation manifest))) (derv (profile-derivation manifest)))
(mbegin %store-monad (mbegin %store-monad
(return (derivation-file-name derv))))))))))) (return (derivation-file-name derv))))))))))
(close-inferior inferior)
file-name))))
(define (channel->manifest-store-item store channel) (define (channel->manifest-store-item store channel)
(let* ((manifest-store-item-derivation-file-name (let* ((manifest-store-item-derivation-file-name
@ -194,18 +200,23 @@
(simple-format #t "guix-data-service: load-new-guix-revision: error: ~A\n" args) (simple-format #t "guix-data-service: load-new-guix-revision: error: ~A\n" args)
#f))) #f)))
(define (extract-information-from store conn url commit store_path) (define (extract-information-from store conn url commit store-path)
(let ((inf (open-inferior/container store store_path (simple-format
#t "debug: extract-information-from: ~A\n" store-path)
(let ((inf (open-inferior/container store store-path
#:extra-shared-directories #:extra-shared-directories
'("/gnu/store")))) '("/gnu/store"))))
(inferior-eval '(use-modules (guix grafts)) inf) (inferior-eval '(use-modules (srfi srfi-1)
(srfi srfi-34)
(guix grafts))
inf)
(inferior-eval '(%graft? #f) inf) (inferior-eval '(%graft? #f) inf)
(exec-query conn "BEGIN") (exec-query conn "BEGIN")
(let ((package-derivation-ids (let ((package-derivation-ids
(inferior-guix->package-derivation-ids store conn inf)) (inferior-guix->package-derivation-ids store conn inf))
(guix-revision-id (guix-revision-id
(insert-guix-revision conn url commit store_path))) (insert-guix-revision conn url commit store-path)))
(insert-guix-revision-package-derivations conn (insert-guix-revision-package-derivations conn
guix-revision-id guix-revision-id
@ -215,9 +226,7 @@
(simple-format (simple-format
#t "Successfully loaded ~A package/derivation pairs\n" #t "Successfully loaded ~A package/derivation pairs\n"
(length package-derivation-ids))) (length package-derivation-ids)))))
(close-inferior inf)))
(define (load-new-guix-revision conn url commit) (define (load-new-guix-revision conn url commit)
(if (guix-revision-exists? conn url commit) (if (guix-revision-exists? conn url commit)