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

Close the load revision inferior prior to inserting data

Browse source 
This means that the lock can be acquired after closing the inferior, freeing
the large amount of memory that the inferior process is probably using.
This commit is contained in:
Christopher Baines 2022-03-11 13:07:34 +00:00
parent df4e0a7a61
commit 097e22ab5e
4 changed files with 183 additions and 138 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -814,49 +814,90 @@ WHERE job_id = $1")
deduplicated-packages)) deduplicated-packages))
(define* (insert-packages conn inf packages #:key (process-replacements? #t)) (define* (all-inferior-packages-data inf packages #:key (process-replacements? #t))
(let* ((package-license-set-ids (let* ((package-license-data
(with-time-logging "fetching inferior package license metadata" (with-time-logging "fetching inferior package license metadata"
(inferior-packages->license-set-ids (inferior-packages->license-data inf packages)))
conn (package-metadata
(inferior-packages->license-id-lists (with-time-logging "fetching inferior package metadata"
conn (map
(inferior-packages->license-data inf packages)))))) (lambda (package)
(let*-values (let ((translated-package-descriptions-and-synopsis
(((all-package-metadata-ids new-package-metadata-ids) (inferior-packages->translated-package-descriptions-and-synopsis
(with-time-logging "fetching inferior package metadata" inf package)))
(inferior-packages->package-metadata-ids (list (non-empty-string-or-false
conn inf packages package-license-set-ids))) (inferior-package-home-page package))
((package-replacement-package-ids) (inferior-package-location package)
(map (lambda (package) (car translated-package-descriptions-and-synopsis)
(let ((replacement (inferior-package-replacement package))) (cdr translated-package-descriptions-and-synopsis))))
(if (and process-replacements? replacement) packages)))
;; I'm not sure if replacements can themselves be (package-replacement-data
;; replaced, but I do know for sure that there are (if process-replacements?
;; infinite chains of replacements (python(2)-urllib3 (map (lambda (package)
;; in 7c4c781aa40c42d4cd10b8d9482199f3db345e1b for (let ((replacement (inferior-package-replacement package)))
;; example). (if replacement
;; ;; I'm not sure if replacements can themselves be
;; This code currently just capures the first level of ;; replaced, but I do know for sure that there are
;; replacements ;; infinite chains of replacements (python(2)-urllib3
(car ;; in 7c4c781aa40c42d4cd10b8d9482199f3db345e1b for
(insert-packages conn inf (list replacement) ;; example).
#:process-replacements? #f)) ;;
(cons "integer" NULL)))) ;; This code currently just capures the first level
packages))) ;; of replacements
(first
(all-inferior-packages-data
inf
(list replacement)
#:process-replacements? #f))
#f)))
packages)
#f)))
(unless (null? new-package-metadata-ids) `((names . ,(map inferior-package-name packages))
(with-time-logging "fetching package metadata tsvector entries" (versions . ,(map inferior-package-version packages))
(insert-package-metadata-tsvector-entries (license-data . ,package-license-data)
conn new-package-metadata-ids))) (metadata . ,package-metadata)
(replacemnets . ,package-replacement-data))))
(with-time-logging "getting package-ids" (define (insert-packages conn inferior-packages-data)
(inferior-packages->package-ids (let*-values
(((package-license-set-ids)
(inferior-packages->license-set-ids
conn conn
(zip (map inferior-package-name packages) (inferior-packages->license-id-lists
(map inferior-package-version packages) conn
all-package-metadata-ids (assq-ref inferior-packages-data 'license-data))))
package-replacement-package-ids)))))) ((all-package-metadata-ids new-package-metadata-ids)
(with-time-logging "inserting package metadata entries"
(inferior-packages->package-metadata-ids
conn
(assq-ref inferior-packages-data 'metadata)
package-license-set-ids)))
((replacement-ids)
(or (and=> (assq-ref inferior-packages-data 'replacements)
(lambda (all-replacement-data)
(with-time-logging "inserting package replacements"
(map (lambda (replacement-data)
(if replacement-data
(first
(insert-packages conn (list replacement-data)))
(cons "integer" NULL)))
all-replacement-data))))
(make-list (length package-license-set-ids)
(cons "integer" NULL)))))
(unless (null? new-package-metadata-ids)
(with-time-logging "fetching package metadata tsvector entries"
(insert-package-metadata-tsvector-entries
conn new-package-metadata-ids)))
(with-time-logging "getting package-ids"
(inferior-packages->package-ids
conn
(zip (assq-ref inferior-packages-data 'names)
(assq-ref inferior-packages-data 'versions)
all-package-metadata-ids
replacement-ids)))))
(define (insert-lint-warnings conn inferior-package-id->package-database-id (define (insert-lint-warnings conn inferior-package-id->package-database-id
lint-checker-ids lint-checker-ids
@ -1289,7 +1330,14 @@ WHERE job_id = $1")
(all-inferior-package-derivations store inf packages))) (all-inferior-package-derivations store inf packages)))
(inferior-system-tests (inferior-system-tests
(with-time-logging "getting inferior system tests" (with-time-logging "getting inferior system tests"
(all-inferior-system-tests inf store)))) (all-inferior-system-tests inf store)))
(packages-data
(with-time-logging "getting all inferior package data"
(all-inferior-packages-data inf packages))))
(simple-format
#t "debug: finished loading information from inferior\n")
(close-inferior inf)
(with-time-logging (with-time-logging
"acquiring advisory transaction lock: load-new-guix-revision-inserts" "acquiring advisory transaction lock: load-new-guix-revision-inserts"
@ -1298,7 +1346,7 @@ WHERE job_id = $1")
(obtain-advisory-transaction-lock conn (obtain-advisory-transaction-lock conn
'load-new-guix-revision-inserts)) 'load-new-guix-revision-inserts))
(let* ((package-ids (let* ((package-ids
(insert-packages conn inf packages)) (insert-packages conn packages-data))
(inferior-package-id->package-database-id (inferior-package-id->package-database-id
(let ((lookup-table (let ((lookup-table
(alist->hashq-table (alist->hashq-table
@ -1316,9 +1364,6 @@ WHERE job_id = $1")
"error: inferior-package-id->package-database-id: ~A missing\n" "error: inferior-package-id->package-database-id: ~A missing\n"
inferior-id))))))) inferior-id)))))))
(simple-format
#t "debug: finished loading information from inferior\n")
(close-inferior inf)
(when inferior-lint-warnings (when inferior-lint-warnings
(let* ((lint-checker-ids (let* ((lint-checker-ids

54
guix-data-service/model/package-metadata.scm
View file

@ -389,43 +389,39 @@ WHERE packages.id IN (
(insert-package-description-set conn package-description-ids)))))) (insert-package-description-set conn package-description-ids))))))
(define (inferior-packages->package-metadata-ids conn (define (inferior-packages->package-metadata-ids conn
inferior package-metadata
packages
license-set-ids) license-set-ids)
(define package-metadata
(map (lambda (package license-set-id)
(let ((translated-package-descriptions-and-synopsis
(inferior-packages->translated-package-descriptions-and-synopsis
inferior package)))
(list (non-empty-string-or-false
(inferior-package-home-page package))
(location->location-id
conn
(inferior-package-location package))
license-set-id
(package-description-data->package-description-set-id
conn
(car translated-package-descriptions-and-synopsis))
(package-synopsis-data->package-synopsis-set-id
conn
(cdr translated-package-descriptions-and-synopsis)))))
packages
license-set-ids))
(insert-missing-data-and-return-all-ids (insert-missing-data-and-return-all-ids
conn conn
"package_metadata" "package_metadata"
'(home_page location_id license_set_id package_description_set_id package_synopsis_set_id) '(home_page
(map (match-lambda location_id
((home-page location-id license-set-id package_description_set_id package_synopsis_set_id) license_set_id
package_description_set_id
package_synopsis_set_id)
(map (match-lambda*
(((home-page
location
package-description-data
package-synopsis-data)
license-set-id)
(list (if (string? home-page) (list (if (string? home-page)
home-page home-page
NULL) NULL)
location-id (location->location-id
conn
location)
license-set-id license-set-id
package_description_set_id (package-description-data->package-description-set-id
package_synopsis_set_id))) conn
package-metadata) package-description-data)
(package-synopsis-data->package-synopsis-set-id
conn
package-synopsis-data))))
package-metadata
license-set-ids)
;; There can be duplicated entires in package-metadata, for example where ;; There can be duplicated entires in package-metadata, for example where
;; you have one package definition which interits from another, and just ;; you have one package definition which interits from another, and just
;; overrides the version and the source, the package_metadata entries for ;; overrides the version and the source, the package_metadata entries for

93
tests/model-package-metadata.scm
View file

@ -29,6 +29,19 @@
(home-page #f) (home-page #f)
(location #f))) (location #f)))
(define mock-inferior-packages
(list mock-inferior-package-foo
mock-inferior-package-foo-2))
(define mock-package-metadata
(map (lambda (mock-inf-pkg)
(list
(mock-inferior-package-home-page mock-inf-pkg)
(mock-inferior-package-location mock-inf-pkg)
`(("en_US.UTF-8" . "Fake synopsis"))
`(("en_US.UTF-8" . "Fake description"))))
mock-inferior-packages))
(define (test-license-set-ids conn) (define (test-license-set-ids conn)
(let ((license-id-lists (let ((license-id-lists
(inferior-packages->license-id-lists (inferior-packages->license-id-lists
@ -39,54 +52,42 @@
(inferior-packages->license-set-ids conn license-id-lists))) (inferior-packages->license-set-ids conn license-id-lists)))
(mock (with-mock-inferior-packages
((guix-data-service model package-metadata) (lambda ()
inferior-packages->translated-package-descriptions-and-synopsis (use-modules (guix-data-service model package)
(lambda (inferior inferior-package) (guix-data-service model git-repository)
(cons `(("en_US.UTF-8" . "Fake synopsis")) (guix-data-service model guix-revision)
`(("en_US.UTF-8" . "Fake description"))))) (guix-data-service model package-metadata))
(with-mock-inferior-packages
(lambda ()
(use-modules (guix-data-service model package)
(guix-data-service model git-repository)
(guix-data-service model guix-revision)
(guix-data-service model package-metadata))
(with-postgresql-connection (with-postgresql-connection
"test-model-package-metadata" "test-model-package-metadata"
(lambda (conn) (lambda (conn)
(check-test-database! conn) (check-test-database! conn)
(test-assert "inferior-packages->package-metadata-ids" (test-assert "inferior-packages->package-metadata-ids"
(with-postgresql-transaction (with-postgresql-transaction
conn conn
(lambda (conn) (lambda (conn)
(match (match
(inferior-packages->package-metadata-ids (inferior-packages->package-metadata-ids
conn conn
"" mock-package-metadata
(list mock-inferior-package-foo (test-license-set-ids conn))
mock-inferior-package-foo-2) ((x) (number? x))))
(test-license-set-ids conn)) #:always-rollback? #t))
((x) (number? x))))
#:always-rollback? #t))
(with-postgresql-transaction (with-postgresql-transaction
conn conn
(lambda (conn) (lambda (conn)
(test-equal "inferior-packages->package-metadata-ids" (test-equal "inferior-packages->package-metadata-ids"
(inferior-packages->package-metadata-ids (inferior-packages->package-metadata-ids
conn conn
"" mock-package-metadata
(list mock-inferior-package-foo (test-license-set-ids conn))
mock-inferior-package-foo-2) (inferior-packages->package-metadata-ids
(test-license-set-ids conn)) conn
(inferior-packages->package-metadata-ids mock-package-metadata
conn (test-license-set-ids conn)))
"" #:always-rollback? #t))))))
(list mock-inferior-package-foo
mock-inferior-package-foo-2)
(test-license-set-ids conn)))
#:always-rollback? #t)))))))
(test-end) (test-end)

41
tests/model-package.scm
View file

@ -5,6 +5,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix tests) #:use-module (guix tests)
#:use-module (tests mock-inferior) #:use-module (tests mock-inferior)
#:use-module (guix-data-service model utils)
#:use-module (guix-data-service model license) #:use-module (guix-data-service model license)
#:use-module (guix-data-service model license-set) #:use-module (guix-data-service model license-set)
#:use-module (guix-data-service model package) #:use-module (guix-data-service model package)
@ -45,16 +46,18 @@
(list mock-inferior-package-foo (list mock-inferior-package-foo
mock-inferior-package-foo-2)) mock-inferior-package-foo-2))
(mock (define mock-package-metadata
((guix-data-service model package-metadata) (map (lambda (mock-inf-pkg)
inferior-packages->translated-package-descriptions-and-synopsis (list
(lambda (inferior inferior-package) (mock-inferior-package-home-page mock-inf-pkg)
(cons `(("en_US.UTF-8" . "Fake synopsis")) (mock-inferior-package-location mock-inf-pkg)
`(("en_US.UTF-8" . "Fake description"))))) `(("en_US.UTF-8" . "Fake synopsis"))
`(("en_US.UTF-8" . "Fake description"))))
mock-inferior-packages))
(with-mock-inferior-packages (with-mock-inferior-packages
(lambda () (lambda ()
(use-modules (guix-data-service model utils) (use-modules (guix-data-service model package)
(guix-data-service model package)
(guix-data-service model git-repository) (guix-data-service model git-repository)
(guix-data-service model guix-revision) (guix-data-service model guix-revision)
(guix-data-service model package-metadata)) (guix-data-service model package-metadata))
@ -68,11 +71,11 @@
conn conn
(lambda (conn) (lambda (conn)
(test-assert "inferior-packages->package-ids works once" (test-assert "inferior-packages->package-ids works once"
(let ((package-metadata-ids (inferior-packages->package-metadata-ids (let ((package-metadata-ids
conn (inferior-packages->package-metadata-ids
"" conn
mock-inferior-packages mock-package-metadata
(test-license-set-ids conn))) (test-license-set-ids conn)))
(package-replacement-package-ids (package-replacement-package-ids
(make-list (length mock-inferior-packages) (make-list (length mock-inferior-packages)
(cons "integer" NULL)))) (cons "integer" NULL))))
@ -88,11 +91,11 @@
(with-postgresql-transaction (with-postgresql-transaction
conn conn
(lambda (conn) (lambda (conn)
(let ((package-metadata-ids (inferior-packages->package-metadata-ids (let ((package-metadata-ids
conn (inferior-packages->package-metadata-ids
"" conn
mock-inferior-packages mock-package-metadata
(test-license-set-ids conn))) (test-license-set-ids conn)))
(package-replacement-package-ids (package-replacement-package-ids
(make-list (length mock-inferior-packages) (make-list (length mock-inferior-packages)
(cons "integer" NULL)))) (cons "integer" NULL))))
@ -109,6 +112,6 @@
(map mock-inferior-package-version mock-inferior-packages) (map mock-inferior-package-version mock-inferior-packages)
package-metadata-ids package-metadata-ids
package-replacement-package-ids))))) package-replacement-package-ids)))))
#:always-rollback? #t)))))) #:always-rollback? #t)))))
(test-end) (test-end)