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

Extract out derivations-insert-sources

Browse source 
As there are derivations missing sources, and this code will be useful to try
and fix things.
This commit is contained in:
Christopher Baines 2025-03-10 10:23:13 +00:00
parent 001805a2c9
commit 35281c8a49
1 changed files with 85 additions and 78 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1003,6 +1003,86 @@
(exec-query conn (select-existing-derivations chunk)))) (exec-query conn (select-existing-derivations chunk))))
(chunk! missing-file-names 1000))))) (chunk! missing-file-names 1000)))))
(define* (derivations-insert-sources postgresql-connection-pool
call-with-utility-thread
derivations
derivation-ids
#:key (log-tag "unspecified"))
(with-time-logging
(string-append "insert-missing-derivations: inserting sources (" log-tag ")")
(fibers-for-each
(lambda (derivation-id derivation)
(let ((sources (derivation-sources derivation)))
(unless (null? sources)
(let ((sources-ids
(with-resource-from-pool postgresql-connection-pool conn
(insert-derivation-sources conn
derivation-id
sources))))
(fibers-for-each
(lambda (id source-file)
(when
(with-resource-from-pool postgresql-connection-pool conn
(match
(exec-query
conn
"
SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(list (number->string id)))
(()
;; Insert a placeholder to avoid other fibers
;; working on this source file
(insert-placeholder-derivation-source-file-nar
conn
id)
#t)
(_ #f)))
;; Use a utility thread to control concurrency here, to
;; avoid using too much memory
(call-with-utility-thread
(lambda ()
(let ((nar-bytevector
(call-with-values
(lambda ()
(open-bytevector-output-port))
(lambda (port get-bytevector)
(unless (file-exists? source-file)
(raise-exception
(make-missing-store-item-error
source-file)))
(write-file source-file port)
(let ((res (get-bytevector)))
(close-port port) ; maybe reduces memory?
res)))))
(let ((compressed-nar-bytevector
(call-with-values
(lambda ()
(open-bytevector-output-port))
(lambda (port get-bytevector)
(call-with-lzip-output-port port
(lambda (port)
(put-bytevector port nar-bytevector))
#:level 9)
(let ((res (get-bytevector)))
(close-port port) ; maybe reduces memory?
res))))
(hash
(bytevector->nix-base32-string
(sha256 nar-bytevector)))
(uncompressed-size
(bytevector-length nar-bytevector)))
(with-resource-from-pool postgresql-connection-pool conn
(update-derivation-source-file-nar
conn
id
hash
compressed-nar-bytevector
uncompressed-size))))))))
sources-ids
sources)))))
derivation-ids
derivations)))
(define* (insert-missing-derivations postgresql-connection-pool (define* (insert-missing-derivations postgresql-connection-pool
call-with-utility-thread call-with-utility-thread
derivation-ids-hash-table derivation-ids-hash-table
@ -1089,90 +1169,17 @@
(values derivations (values derivations
derivation-ids))))))) derivation-ids)))))))
(define (insert-sources derivations derivation-ids)
(with-time-logging
(string-append "insert-missing-derivations: inserting sources (" log-tag ")")
(fibers-for-each
(lambda (derivation-id derivation)
(let ((sources (derivation-sources derivation)))
(unless (null? sources)
(let ((sources-ids
(with-resource-from-pool postgresql-connection-pool conn
(insert-derivation-sources conn
derivation-id
sources))))
(fibers-for-each
(lambda (id source-file)
(when
(with-resource-from-pool postgresql-connection-pool conn
(match
(exec-query
conn
"
SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(list (number->string id)))
(()
;; Insert a placeholder to avoid other fibers
;; working on this source file
(insert-placeholder-derivation-source-file-nar
conn
id)
#t)
(_ #f)))
;; Use a utility thread to control concurrency here, to
;; avoid using too much memory
(call-with-utility-thread
(lambda ()
(let ((nar-bytevector
(call-with-values
(lambda ()
(open-bytevector-output-port))
(lambda (port get-bytevector)
(unless (file-exists? source-file)
(raise-exception
(make-missing-store-item-error
source-file)))
(write-file source-file port)
(let ((res (get-bytevector)))
(close-port port) ; maybe reduces memory?
res)))))
(let ((compressed-nar-bytevector
(call-with-values
(lambda ()
(open-bytevector-output-port))
(lambda (port get-bytevector)
(call-with-lzip-output-port port
(lambda (port)
(put-bytevector port nar-bytevector))
#:level 9)
(let ((res (get-bytevector)))
(close-port port) ; maybe reduces memory?
res))))
(hash
(bytevector->nix-base32-string
(sha256 nar-bytevector)))
(uncompressed-size
(bytevector-length nar-bytevector)))
(with-resource-from-pool postgresql-connection-pool conn
(update-derivation-source-file-nar
conn
id
hash
compressed-nar-bytevector
uncompressed-size))))))))
(vector->list sources-ids)
sources)))))
(vector->list derivation-ids)
(vector->list derivations))))
(let ((derivations (let ((derivations
derivation-ids derivation-ids
(insert-derivations))) (insert-derivations)))
(unless (null? derivations) (unless (null? derivations)
(fibers-parallel (fibers-parallel
(insert-sources derivations (derivations-insert-sources postgresql-connection-pool
derivation-ids) call-with-utility-thread
derivations
derivation-ids
#:log-tag log-tag)
(with-time-logging (with-time-logging
(string-append "insert-missing-derivations: inserting outputs (" (string-append "insert-missing-derivations: inserting outputs ("
log-tag ")") log-tag ")")