diff options
| author | Christopher Baines <mail@cbaines.net> | 2025-02-03 21:47:53 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2025-02-03 22:59:34 +0000 |
| commit | 931b7bc5934f3bc05c6eb5841ad9239c36d6181e (patch) | |
| tree | fb4fad070232a33bf56e296efb32426cc6fa84cb /guix-data-service/jobs | |
| parent | acdedb075d144bddd12bf6260fa38ba654f90819 (diff) | |
| download | data-service-931b7bc5934f3bc05c6eb5841ad9239c36d6181e.tar data-service-931b7bc5934f3bc05c6eb5841ad9239c36d6181e.tar.gz | |
Add a slightly crude method to ignore systems and targets
While processing a revision. It would be good to also record what systems and
targets are in the platforms so it's clear what data is missing, but that can
be added later.
Diffstat (limited to 'guix-data-service/jobs')
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 61 |
1 files changed, 50 insertions, 11 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index f82b27e..1e88436 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -1355,7 +1355,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (define* (channel->source-and-derivation-file-names-by-system conn channel fetch-with-authentication? - #:key parallelism) + #:key parallelism ignore-systems) (define use-container? (defined? 'open-inferior/container @@ -1496,8 +1496,21 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (with-resource-from-pool inferior-and-store-pool res (match res ((inferior . inferior-store) - (inferior-eval '(@ (guix packages) %supported-systems) - inferior))))) + (let* ((systems + (inferior-eval '(@ (guix packages) %supported-systems) + inferior)) + (ignored-systems + (lset-intersection string=? + systems + ignore-systems))) + (unless (null? ignored-systems) + (simple-format + (current-error-port) + "ignoring systems: ~A\n" + ignored-systems)) + (lset-difference string=? + systems + ignored-systems)))))) (result (fibers-map (lambda (system) @@ -1536,13 +1549,15 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (define* (channel->source-and-derivations-by-system conn channel fetch-with-authentication? - #:key parallelism) + #:key parallelism + ignore-systems) (match (with-time-logging "computing the channel derivation" (channel->source-and-derivation-file-names-by-system conn channel fetch-with-authentication? - #:parallelism parallelism)) + #:parallelism parallelism + #:ignore-systems ignore-systems)) ((source . derivation-file-names-by-system) (for-each (match-lambda @@ -1752,7 +1767,8 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" derivation-ids-hash-table #:key skip-system-tests? extra-inferior-environment-variables - parallelism) + parallelism + ignore-systems ignore-targets) (define guix-locpath ;; Augment the GUIX_LOCPATH to include glibc-locales from @@ -2130,9 +2146,24 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (process-system-and-target system target get-derivations/fiberized))))) (list - (call-with-inferior - (lambda (inferior inferior-store) - (inferior-fetch-system-target-pairs inferior)))) + (let ((all-system-target-pairs + (call-with-inferior + (lambda (inferior inferior-store) + (inferior-fetch-system-target-pairs inferior))))) + (filter + (match-lambda + ((system . target) + (if (or (member system ignore-systems) + (member target ignore-targets)) + (begin + (simple-format + (current-error-port) + "ignoring ~A ~A for package derivations\n" + system + target) + #f) + #t))) + all-system-target-pairs))) #:report (lambda (data) (for-each @@ -2270,7 +2301,8 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (define* (load-new-guix-revision conn git-repository-id commit #:key skip-system-tests? parallelism - extra-inferior-environment-variables) + extra-inferior-environment-variables + ignore-systems ignore-targets) (define call-with-utility-thread (let* ((thread-pool (call-with-default-io-waiters @@ -2326,7 +2358,8 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" channel-conn channel-for-commit fetch-with-authentication? - #:parallelism parallelism)))))) + #:parallelism parallelism + #:ignore-systems ignore-systems)))))) (define guix-revision-id-promise (fibers-delay @@ -2370,6 +2403,8 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" skip-system-tests? #:extra-inferior-environment-variables extra-inferior-environment-variables + #:ignore-systems ignore-systems + #:ignore-targets ignore-targets #:parallelism parallelism) (if (defined? 'channel-news-for-commit @@ -2790,6 +2825,8 @@ SKIP LOCKED") (define* (process-load-new-guix-revision-job id #:key skip-system-tests? extra-inferior-environment-variables + ignore-systems + ignore-targets parallelism) (define finished-channel (make-channel)) @@ -2868,6 +2905,8 @@ SKIP LOCKED") #:skip-system-tests? #t #:extra-inferior-environment-variables extra-inferior-environment-variables + #:ignore-systems ignore-systems + #:ignore-targets ignore-targets #:parallelism parallelism)) (lambda (key . args) (simple-format (current-error-port) |