diff options
author | Christopher Baines <mail@cbaines.net> | 2023-08-03 10:07:33 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2023-08-03 10:07:33 +0100 |
commit | 4808d8f4e1483072a033a714f4f9090ff75cd87c (patch) | |
tree | 8d796d2363c82feabcbe254775fa9e19609783cd /guix-build-coordinator | |
parent | 11be46e5acc3517fd37642cfa05e9a71e5ee2274 (diff) | |
download | build-coordinator-4808d8f4e1483072a033a714f4f9090ff75cd87c.tar build-coordinator-4808d8f4e1483072a033a714f4f9090ff75cd87c.tar.gz |
Keep less derivation files open when reading derivations
This probably isn't the main problem with having too many open files, but it
might help avoid bursts of open files.
Diffstat (limited to 'guix-build-coordinator')
-rw-r--r-- | guix-build-coordinator/agent.scm | 8 | ||||
-rw-r--r-- | guix-build-coordinator/client-communication.scm | 2 | ||||
-rw-r--r-- | guix-build-coordinator/coordinator.scm | 2 | ||||
-rw-r--r-- | guix-build-coordinator/hooks.scm | 2 | ||||
-rw-r--r-- | guix-build-coordinator/utils.scm | 27 |
5 files changed, 30 insertions, 11 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index 68f9b86..5eeacdc 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -277,7 +277,7 @@ (define (get-compressed-outputs store) (let ((outputs (derivation-outputs - (read-derivation-from-file derivation-name)))) + (read-derivation-from-file* derivation-name)))) (for-each (match-lambda ((_ . output) @@ -354,7 +354,7 @@ (report-build-start coordinator-interface build-id #:log (build-log-procedure lgr build-id)) - (let* ((derivation (read-derivation-from-file derivation-name)) + (let* ((derivation (read-derivation-from-file* derivation-name)) (result (perform-build lgr store build-id derivation)) ;; TODO Check this handles timezones right (end-time (localtime (time-second (current-time)) "UTC")) @@ -862,7 +862,7 @@ but the guix-daemon claims it's unavailable" (if (valid-path? store derivation-name) (begin (add-temp-root store derivation-name) - (read-derivation-from-file derivation-name)) + (read-derivation-from-file* derivation-name)) (and (with-exception-handler (lambda (exn) @@ -886,7 +886,7 @@ but the guix-daemon claims it's unavailable" #:delay (random 15)) #t) #:unwind? #t) - (read-derivation-from-file derivation-name))))) + (read-derivation-from-file* derivation-name))))) (if derivation (begin (log-msg lgr 'DEBUG diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 66f0a9c..4c1702d 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -448,7 +448,7 @@ (lambda () (substitute-derivation derivation-file #:substitute-urls substitute-urls)))) - (read-derivation-from-file derivation-file)) + (read-derivation-from-file* derivation-file)) (let ((submit-build-result (call-with-delay-logging diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 859fd44..255fca7 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -552,7 +552,7 @@ (ensure-all-related-derivation-outputs-have-builds? #f) (tags '()) defer-until - (read-drv read-derivation-from-file)) + (read-drv read-derivation-from-file*)) (define datastore (build-coordinator-datastore build-coordinator)) (define (build-for-derivation-exists?) diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm index 77a59a0..fef3bd6 100644 --- a/guix-build-coordinator/hooks.scm +++ b/guix-build-coordinator/hooks.scm @@ -141,7 +141,7 @@ derivation-substitute-urls) (add-temp-root store drv-name)) - (let* ((drv (read-derivation-from-file drv-name)) + (let* ((drv (read-derivation-from-file* drv-name)) (drv-sources (derivation-sources drv)) (referenced-source-files diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index 06c22c6..197c002 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -66,6 +66,8 @@ find-missing-substitutes-for-output has-substiutes-no-cache? + read-derivation-from-file* + substitute-derivation read-derivation-through-substitutes @@ -461,6 +463,23 @@ (error (simple-format #f "could not substitute ~A\n" derivation-name))))))))) +(define read-derivation-from-file* + (let ((%derivation-cache + (@@ (guix derivations) %derivation-cache))) + (lambda (file) + (or (and file (hash-ref %derivation-cache file)) + (let ((drv + ;; read-derivation can call read-derivation-from-file, so to + ;; avoid having many open files when reading a derivation with + ;; inputs, read it in to a string first. + (call-with-input-string + (call-with-input-file file + get-string-all) + (lambda (port) + (read-derivation port read-derivation-from-file*))))) + (hash-set! %derivation-cache file drv) + drv))))) + (define %derivation-cache (make-doubly-weak-hash-table)) @@ -551,13 +570,13 @@ (error "could not fetch narinfo")))) (with-store store - (define (read-derivation-from-file* derivation-name) + (define (read-derivation-from-file/custom derivation-name) (or (hash-ref %derivation-cache derivation-name) ;; Try the local store (and (file-exists? derivation-name) (valid-path? store derivation-name) - (read-derivation-from-file derivation-name)) + (read-derivation-from-file* derivation-name)) ;; Otherwise try the network (let ((drv @@ -566,7 +585,7 @@ (lambda (port) (set-port-filename! port derivation-name) (read-derivation port - read-derivation-from-file*))))) + read-derivation-from-file/custom))))) (hash-set! %derivation-cache derivation-name @@ -574,7 +593,7 @@ drv))) - (read-derivation-from-file* derivation-name))) + (read-derivation-from-file/custom derivation-name))) (define* (narinfo-string store-path hash size references compressed-files |