From 35281c8a49f12600abb7dc73701fa7cd8f41558b Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Mon, 10 Mar 2025 10:23:13 +0000 Subject: [PATCH] Extract out derivations-insert-sources As there are derivations missing sources, and this code will be useful to try and fix things. --- .../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 ")")