summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-10-04 16:34:38 +0200
committerLudovic Courtès <ludo@gnu.org>2021-10-04 16:36:59 +0200
commit688a4db071736a772e6b5515d7c03fe501c3c15a (patch)
tree3792d02d46caa64bfe5dabef1543a8cff6bd2949 /gnu
parentb628c5fc71ab5b6db3ae35dcccd66bacef98252d (diff)
ci: Allow manifests to contain any lowerable object.
Previously, manifests could only contain packages: https://lists.gnu.org/archive/html/guix-devel/2021-10/msg00002.html This allows us to pass origins as found in 'etc/source-manifest.scm'. * gnu/ci.scm (derivation->job): Change default #:timeout value to 5h. (manifests->packages): Remove. (manifests->jobs): New procedure. (cuirass-jobs): Use it in the 'manifests' case.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/ci.scm47
1 files changed, 32 insertions, 15 deletions
diff --git a/gnu/ci.scm b/gnu/ci.scm
index ceb1b94af99..e1011355db1 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2017, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> 3;;; Copyright © 2017, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
4;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org> 4;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
5;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu> 5;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
@@ -86,7 +86,7 @@
86(define* (derivation->job name drv 86(define* (derivation->job name drv
87 #:key 87 #:key
88 (max-silent-time 3600) 88 (max-silent-time 3600)
89 (timeout 3600)) 89 (timeout (* 5 3600)))
90 "Return a Cuirass job called NAME and describing DRV. 90 "Return a Cuirass job called NAME and describing DRV.
91 91
92MAX-SILENT-TIME and TIMEOUT are build options passed to the daemon when 92MAX-SILENT-TIME and TIMEOUT are build options passed to the daemon when
@@ -443,19 +443,40 @@ valid."
443 (map channel-url channels))) 443 (map channel-url channels)))
444 arguments)) 444 arguments))
445 445
446(define (manifests->packages store manifests) 446(define (manifests->jobs store manifests)
447 "Return the list of packages found in MANIFESTS." 447 "Return the list of jobs for the entries in MANIFESTS, a list of file
448names."
448 (define (load-manifest manifest) 449 (define (load-manifest manifest)
449 (save-module-excursion 450 (save-module-excursion
450 (lambda () 451 (lambda ()
451 (set-current-module (make-user-module '((guix profiles) (gnu)))) 452 (set-current-module (make-user-module '((guix profiles) (gnu))))
452 (primitive-load manifest)))) 453 (primitive-load manifest))))
453 454
454 (delete-duplicates! 455 (define (manifest-entry-job-name entry)
455 (map manifest-entry-item 456 (string-append (manifest-entry-name entry) "-"
456 (append-map (compose manifest-entries 457 (manifest-entry-version entry)))
457 load-manifest) 458
458 manifests)))) 459 (define (manifest-entry->job entry)
460 (let* ((obj (manifest-entry-item entry))
461 (drv (parameterize ((%graft? #f))
462 (run-with-store store
463 (lower-object obj))))
464 (max-silent-time (or (and (package? obj)
465 (assoc-ref (package-properties obj)
466 'max-silent-time))
467 3600))
468 (timeout (or (and (package? obj)
469 (assoc-ref (package-properties obj) 'timeout))
470 (* 5 3600))))
471 (derivation->job (manifest-entry-job-name entry) drv
472 #:max-silent-time max-silent-time
473 #:timeout timeout)))
474
475 (map manifest-entry->job
476 (delete-duplicates
477 (append-map (compose manifest-entries load-manifest)
478 manifests)
479 manifest-entry=?)))
459 480
460(define (arguments->systems arguments) 481(define (arguments->systems arguments)
461 "Return the systems list from ARGUMENTS." 482 "Return the systems list from ARGUMENTS."
@@ -568,12 +589,8 @@ valid."
568 packages))) 589 packages)))
569 (('manifests . rest) 590 (('manifests . rest)
570 ;; Build packages in the list of manifests. 591 ;; Build packages in the list of manifests.
571 (let* ((manifests (arguments->manifests rest channels)) 592 (let ((manifests (arguments->manifests rest channels)))
572 (packages (manifests->packages store manifests))) 593 (manifests->jobs store manifests)))
573 (map (lambda (package)
574 (package-job store (job-name package)
575 package system))
576 packages)))
577 (else 594 (else
578 (error "unknown subset" subset)))) 595 (error "unknown subset" subset))))
579 systems))) 596 systems)))