diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index a9dedc4..985dab4 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -1385,7 +1385,9 @@ SELECT store_path FROM derivation_source_files WHERE id = $1" #:parallelism 1 #:drain? #t)) -(define (find-broken-derivations-in-revision commit) +(define* (find-broken-derivations-in-revision + commit + #:key (ignore-systems '()) (ignore-targets '())) (run-fibers (lambda () (with-exception-handler @@ -1397,21 +1399,24 @@ SELECT store_path FROM derivation_source_files WHERE id = $1" (fibers-batch-map (match-lambda ((system target) - (with-postgresql-connection - "fix" - (lambda (conn) - (simple-format #t "checking: ~A ~A\n" system target) - (map - car - (exec-query - conn - (string-append - (get-sql-to-select-package-and-related-derivations-for-revision - conn - (commit->revision-id conn commit) - #:system-id (system->system-id conn system) - #:target target) - " + (if (or (member system ignore-systems) + (member target ignore-targets)) + '() + (with-postgresql-connection + "fix" + (lambda (conn) + (simple-format #t "checking: ~A ~A\n" system target) + (map + car + (exec-query + conn + (string-append + (get-sql-to-select-package-and-related-derivations-for-revision + conn + (commit->revision-id conn commit) + #:system-id (system->system-id conn system) + #:target target) + " SELECT derivations.file_name FROM all_derivations INNER JOIN derivations ON all_derivations.derivation_id = derivations.id @@ -1419,7 +1424,7 @@ WHERE builder != 'builtin:download' AND builder != 'builtin:git-download' AND NOT EXISTS ( SELECT 1 FROM derivation_inputs WHERE derivation_id = derivations.id -)"))))))) +)")))))))) 6 (with-postgresql-connection "fix" @@ -1519,7 +1524,12 @@ WHERE builder != 'builtin:download' (parallelism 4) inferior-memory-limit) (let ((broken-derivations - (find-broken-derivations-in-revision commit))) + (find-broken-derivations-in-revision + commit + #:ignore-systems ignore-systems + #:ignore-targets ignore-targets))) + (simple-format #t "~A broken derivations\n" + (length broken-derivations)) (run-fibers (lambda () (with-exception-handler