cbaines pushed a commit to branch trunk
in repository data-service.
commit 35281c8a49f12600abb7dc73701fa7cd8f41558b
Author: Christopher Baines <[email protected]>
AuthorDate: Mon Mar 10 10:23:13 2025 +0000
Extract out derivations-insert-sources
As there are derivations missing sources, and this code will be useful to
try
and fix things.
---
guix-data-service/jobs/load-new-guix-revision.scm | 163 +++++++++++-----------
1 file changed, 85 insertions(+), 78 deletions(-)
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm
b/guix-data-service/jobs/load-new-guix-revision.scm
index c69e2a9..c8bf2e6 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -1003,6 +1003,86 @@
(exec-query conn (select-existing-derivations chunk))))
(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
call-with-utility-thread
derivation-ids-hash-table
@@ -1089,90 +1169,17 @@
(values derivations
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
derivation-ids
(insert-derivations)))
(unless (null? derivations)
(fibers-parallel
- (insert-sources derivations
- derivation-ids)
+ (derivations-insert-sources postgresql-connection-pool
+ call-with-utility-thread
+ derivations
+ derivation-ids
+ #:log-tag log-tag)
(with-time-logging
(string-append "insert-missing-derivations: inserting outputs ("
log-tag ")")
