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