Commit | Line | Data |
---|---|---|
233e7676 | 1 | ;;; GNU Guix --- Functional package management for GNU |
9410a5aa | 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> |
8c0e5b1e | 3 | ;;; |
233e7676 | 4 | ;;; This file is part of GNU Guix. |
8c0e5b1e | 5 | ;;; |
233e7676 | 6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
8c0e5b1e LC |
7 | ;;; under the terms of the GNU General Public License as published by |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
233e7676 | 11 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
8c0e5b1e LC |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
233e7676 | 17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
8c0e5b1e LC |
18 | |
19 | ;;; | |
20 | ;;; This file defines build jobs for the Hydra continuation integration | |
21 | ;;; tool. | |
22 | ;;; | |
23 | ||
0b5aa854 LC |
24 | ;; Attempt to use our very own Guix modules. |
25 | (eval-when (compile load eval) | |
bb90ad83 LC |
26 | |
27 | ;; Ignore any available .go, and force recompilation. This is because our | |
28 | ;; checkout in the store has mtime set to the epoch, and thus .go files look | |
29 | ;; newer, even though they may not correspond. | |
30 | (set! %fresh-auto-compile #t) | |
31 | ||
0b5aa854 LC |
32 | (and=> (assoc-ref (current-source-location) 'filename) |
33 | (lambda (file) | |
f3211ef3 | 34 | (let ((dir (string-append (dirname file) "/../.."))) |
0b5aa854 LC |
35 | (format (current-error-port) "prepending ~s to the load path~%" |
36 | dir) | |
37 | (set! %load-path (cons dir %load-path)))))) | |
38 | ||
731b9962 LC |
39 | (use-modules (guix config) |
40 | (guix store) | |
49c4fd2a | 41 | (guix grafts) |
8c0e5b1e | 42 | (guix packages) |
97d010b7 | 43 | (guix derivations) |
731b9962 LC |
44 | (guix monads) |
45 | ((guix licenses) #:select (gpl3+)) | |
dce3a40b | 46 | ((guix utils) #:select (%current-system)) |
731b9962 | 47 | ((guix scripts system) #:select (read-operating-system)) |
59a43334 | 48 | (gnu packages) |
d452b595 | 49 | (gnu packages gcc) |
1ffa7090 | 50 | (gnu packages base) |
923fbae1 | 51 | (gnu packages gawk) |
1ffa7090 | 52 | (gnu packages guile) |
aa289a3e | 53 | (gnu packages gettext) |
dfb74e50 | 54 | (gnu packages compression) |
929c0f69 LC |
55 | (gnu packages multiprecision) |
56 | (gnu packages make-bootstrap) | |
b6075935 | 57 | (gnu packages package-management) |
731b9962 LC |
58 | (gnu system) |
59 | (gnu system vm) | |
10d86d54 | 60 | (gnu system install) |
e702e26a | 61 | (gnu tests) |
bdd7eb27 | 62 | (srfi srfi-1) |
dce3a40b | 63 | (srfi srfi-26) |
8c0e5b1e LC |
64 | (ice-9 match)) |
65 | ||
dce3a40b LC |
66 | ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output |
67 | ;; port to the bit bucket, let us write to the error port instead. | |
68 | (setvbuf (current-error-port) _IOLBF) | |
69 | (set-current-output-port (current-error-port)) | |
70 | ||
929c0f69 LC |
71 | (define* (package->alist store package system |
72 | #:optional (package-derivation package-derivation)) | |
8c0e5b1e | 73 | "Convert PACKAGE to an alist suitable for Hydra." |
9c3bb4c5 LC |
74 | (parameterize ((%graft? #f)) |
75 | `((derivation . ,(derivation-file-name | |
76 | (package-derivation store package system | |
77 | #:graft? #f))) | |
78 | (description . ,(package-synopsis package)) | |
79 | (long-description . ,(package-description package)) | |
80 | (license . ,(package-license package)) | |
81 | (home-page . ,(package-home-page package)) | |
82 | (maintainers . ("bug-guix@gnu.org")) | |
83 | (max-silent-time . ,(or (assoc-ref (package-properties package) | |
84 | 'max-silent-time) | |
85 | 3600)) ;1 hour by default | |
86 | (timeout . ,(or (assoc-ref (package-properties package) 'timeout) | |
87 | 72000))))) ;20 hours by default | |
8c0e5b1e LC |
88 | |
89 | (define (package-job store job-name package system) | |
90 | "Return a job called JOB-NAME that builds PACKAGE on SYSTEM." | |
195e81aa LC |
91 | (let ((job-name (symbol-append job-name (string->symbol ".") |
92 | (string->symbol system)))) | |
93 | `(,job-name . ,(cut package->alist store package system)))) | |
8c0e5b1e | 94 | |
929c0f69 LC |
95 | (define (package-cross-job store job-name package target system) |
96 | "Return a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET on | |
97 | SYSTEM." | |
195e81aa LC |
98 | `(,(symbol-append (string->symbol target) (string->symbol ".") job-name |
99 | (string->symbol ".") (string->symbol system)) . | |
929c0f69 | 100 | ,(cute package->alist store package system |
9c960731 LC |
101 | (lambda* (store package system #:key graft?) |
102 | (package-cross-derivation store package target system | |
103 | #:graft? graft?))))) | |
929c0f69 | 104 | |
6bf25b7b | 105 | (define %core-packages |
707c8b2c LC |
106 | ;; Note: Don't put the '-final' package variants because (1) that's |
107 | ;; implicit, and (2) they cannot be cross-built (due to the explicit input | |
108 | ;; chain.) | |
629f4d2e | 109 | (list gcc-4.8 gcc-4.9 gcc-5 glibc binutils |
17315967 | 110 | gmp mpfr mpc coreutils findutils diffutils patch sed grep |
dfb74e50 | 111 | gawk gnu-gettext hello guile-2.0 zlib gzip xz |
9306d350 LC |
112 | %bootstrap-binaries-tarball |
113 | %binutils-bootstrap-tarball | |
530b8bda | 114 | (%glibc-bootstrap-tarball) |
9306d350 | 115 | %gcc-bootstrap-tarball |
58ab9f9b LC |
116 | %guile-bootstrap-tarball |
117 | %bootstrap-tarballs)) | |
929c0f69 | 118 | |
6bf25b7b LC |
119 | (define %packages-to-cross-build |
120 | %core-packages) | |
121 | ||
929c0f69 | 122 | (define %cross-targets |
58ab9f9b | 123 | '("mips64el-linux-gnu" |
6ef6246c | 124 | "mips64el-linux-gnuabi64" |
9410a5aa | 125 | "arm-linux-gnueabihf" |
74288230 | 126 | "i686-w64-mingw32" |
9410a5aa | 127 | "powerpc-linux-gnu")) |
929c0f69 | 128 | |
e702e26a LC |
129 | (define %guixsd-supported-systems |
130 | '("x86_64-linux" "i686-linux")) | |
131 | ||
731b9962 LC |
132 | (define (qemu-jobs store system) |
133 | "Return a list of jobs that build QEMU images for SYSTEM." | |
134 | (define (->alist drv) | |
0ec6237b | 135 | `((derivation . ,(derivation-file-name drv)) |
731b9962 LC |
136 | (description . "Stand-alone QEMU image of the GNU system") |
137 | (long-description . "This is a demo stand-alone QEMU image of the GNU | |
138 | system.") | |
139 | (license . ,gpl3+) | |
140 | (home-page . ,%guix-home-page-url) | |
141 | (maintainers . ("bug-guix@gnu.org")))) | |
142 | ||
143 | (define (->job name drv) | |
144 | (let ((name (symbol-append name (string->symbol ".") | |
145 | (string->symbol system)))) | |
9c3bb4c5 LC |
146 | `(,name . ,(lambda () |
147 | (parameterize ((%graft? #f)) | |
148 | (->alist drv)))))) | |
731b9962 | 149 | |
10d86d54 LC |
150 | (define MiB |
151 | (expt 2 20)) | |
152 | ||
e702e26a | 153 | (if (member system %guixsd-supported-systems) |
a3a27745 | 154 | (list (->job 'usb-image |
10d86d54 | 155 | (run-with-store store |
e87f0591 LC |
156 | (mbegin %store-monad |
157 | (set-guile-for-build (default-guile)) | |
158 | (system-disk-image installation-os | |
159 | #:disk-image-size | |
622b2304 | 160 | (* 1024 MiB)))))) |
731b9962 LC |
161 | '())) |
162 | ||
e702e26a LC |
163 | (define (system-test-jobs store system) |
164 | "Return a list of jobs for the system tests." | |
ab23fb83 LC |
165 | (define (test->thunk test) |
166 | (lambda () | |
167 | (define drv | |
168 | (run-with-store store | |
169 | (mbegin %store-monad | |
170 | (set-current-system system) | |
171 | (set-grafting #f) | |
172 | (set-guile-for-build (default-guile)) | |
173 | (system-test-value test)))) | |
174 | ||
175 | `((derivation . ,(derivation-file-name drv)) | |
176 | (description . ,(format #f "GuixSD '~a' system test" | |
177 | (system-test-name test))) | |
178 | (long-description . ,(system-test-description test)) | |
179 | (license . ,gpl3+) | |
180 | (home-page . ,%guix-home-page-url) | |
181 | (maintainers . ("bug-guix@gnu.org"))))) | |
182 | ||
e702e26a LC |
183 | (define (->job test) |
184 | (let ((name (string->symbol | |
185 | (string-append "test." (system-test-name test) | |
186 | "." system)))) | |
ab23fb83 | 187 | (cons name (test->thunk test)))) |
e702e26a LC |
188 | |
189 | (if (member system %guixsd-supported-systems) | |
190 | (map ->job (all-system-tests)) | |
191 | '())) | |
192 | ||
b6075935 LC |
193 | (define (tarball-jobs store system) |
194 | "Return Hydra jobs to build the self-contained Guix binary tarball." | |
195 | (define (->alist drv) | |
196 | `((derivation . ,(derivation-file-name drv)) | |
197 | (description . "Stand-alone binary Guix tarball") | |
198 | (long-description . "This is a tarball containing binaries of Guix and | |
199 | all its dependencies, and ready to be installed on non-GuixSD distributions.") | |
200 | (license . ,gpl3+) | |
201 | (home-page . ,%guix-home-page-url) | |
202 | (maintainers . ("bug-guix@gnu.org")))) | |
203 | ||
204 | (define (->job name drv) | |
205 | (let ((name (symbol-append name (string->symbol ".") | |
206 | (string->symbol system)))) | |
9c3bb4c5 LC |
207 | `(,name . ,(lambda () |
208 | (parameterize ((%graft? #f)) | |
209 | (->alist drv)))))) | |
b6075935 LC |
210 | |
211 | ;; XXX: Add a job for the stable Guix? | |
212 | (list (->job 'binary-tarball | |
213 | (run-with-store store | |
214 | (mbegin %store-monad | |
215 | (set-guile-for-build (default-guile)) | |
216 | (self-contained-tarball)) | |
217 | #:system system)))) | |
218 | ||
4e097f86 LC |
219 | (define job-name |
220 | ;; Return the name of a package's job. | |
221 | (compose string->symbol package-full-name)) | |
222 | ||
223 | (define package->job | |
224 | (let ((base-packages | |
225 | (delete-duplicates | |
226 | (append-map (match-lambda | |
227 | ((_ package _ ...) | |
228 | (match (package-transitive-inputs package) | |
229 | (((_ inputs _ ...) ...) | |
230 | inputs)))) | |
0a050ebc | 231 | (%final-inputs))))) |
4e097f86 LC |
232 | (lambda (store package system) |
233 | "Return a job for PACKAGE on SYSTEM, or #f if this combination is not | |
234 | valid." | |
235 | (cond ((member package base-packages) | |
236 | #f) | |
bbceb0ef | 237 | ((supported-package? package system) |
4e097f86 LC |
238 | (package-job store (job-name package) package system)) |
239 | (else | |
240 | #f))))) | |
241 | ||
242 | \f | |
243 | ;;; | |
244 | ;;; Hydra entry point. | |
245 | ;;; | |
246 | ||
8c0e5b1e LC |
247 | (define (hydra-jobs store arguments) |
248 | "Return Hydra jobs." | |
6bf25b7b LC |
249 | (define subset |
250 | (match (assoc-ref arguments 'subset) | |
251 | ("core" 'core) ; only build core packages | |
252 | (_ 'all))) ; build everything | |
253 | ||
77bed842 | 254 | (define (cross-jobs system) |
e7958902 | 255 | (define (from-32-to-64? target) |
eb55e28c MW |
256 | ;; Return true if SYSTEM is 32-bit and TARGET is 64-bit. This hack |
257 | ;; prevents known-to-fail cross-builds from i686-linux or armhf-linux to | |
e7958902 | 258 | ;; mips64el-linux-gnuabi64. |
eb55e28c MW |
259 | (and (or (string-prefix? "i686-" system) |
260 | (string-prefix? "armhf-" system)) | |
e7958902 LC |
261 | (string-suffix? "64" target))) |
262 | ||
411fc81d LC |
263 | (define (same? target) |
264 | ;; Return true if SYSTEM and TARGET are the same thing. This is so we | |
265 | ;; don't try to cross-compile to 'mips64el-linux-gnu' from | |
266 | ;; 'mips64el-linux'. | |
267 | (string-contains target system)) | |
268 | ||
dea91108 LC |
269 | (define (pointless? target) |
270 | ;; Return #t if it makes no sense to cross-build to TARGET from SYSTEM. | |
271 | (and (string-contains target "mingw") | |
272 | (not (string=? "x86_64-linux" system)))) | |
273 | ||
a69bc707 | 274 | (define (either proc1 proc2 proc3) |
411fc81d | 275 | (lambda (x) |
a69bc707 | 276 | (or (proc1 x) (proc2 x) (proc3 x)))) |
411fc81d | 277 | |
929c0f69 LC |
278 | (append-map (lambda (target) |
279 | (map (lambda (package) | |
280 | (package-cross-job store (job-name package) | |
281 | package target system)) | |
282 | %packages-to-cross-build)) | |
dea91108 LC |
283 | (remove (either from-32-to-64? same? pointless?) |
284 | %cross-targets))) | |
929c0f69 | 285 | |
49c4fd2a LC |
286 | ;; Turn off grafts. Grafting is meant to happen on the user's machines. |
287 | (parameterize ((%graft? #f)) | |
288 | ;; Return one job for each package, except bootstrap packages. | |
289 | (append-map (lambda (system) | |
290 | (case subset | |
291 | ((all) | |
292 | ;; Build everything, including replacements. | |
293 | (let ((all (fold-packages | |
294 | (lambda (package result) | |
295 | (if (package-replacement package) | |
296 | (cons* package | |
297 | (package-replacement package) | |
298 | result) | |
299 | (cons package result))) | |
300 | '())) | |
301 | (job (lambda (package) | |
302 | (package->job store package | |
303 | system)))) | |
304 | (append (filter-map job all) | |
305 | (qemu-jobs store system) | |
e702e26a | 306 | (system-test-jobs store system) |
49c4fd2a LC |
307 | (tarball-jobs store system) |
308 | (cross-jobs system)))) | |
309 | ((core) | |
310 | ;; Build core packages only. | |
311 | (append (map (lambda (package) | |
312 | (package-job store (job-name package) | |
313 | package system)) | |
314 | %core-packages) | |
315 | (cross-jobs system))) | |
316 | (else | |
317 | (error "unknown subset" subset)))) | |
318 | %hydra-supported-systems))) |