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) |
239c2266 | 42 | (guix profiles) |
8c0e5b1e | 43 | (guix packages) |
97d010b7 | 44 | (guix derivations) |
731b9962 LC |
45 | (guix monads) |
46 | ((guix licenses) #:select (gpl3+)) | |
dce3a40b | 47 | ((guix utils) #:select (%current-system)) |
731b9962 | 48 | ((guix scripts system) #:select (read-operating-system)) |
239c2266 LC |
49 | ((guix scripts pack) |
50 | #:select (lookup-compressor self-contained-tarball)) | |
59a43334 | 51 | (gnu packages) |
d452b595 | 52 | (gnu packages gcc) |
1ffa7090 | 53 | (gnu packages base) |
923fbae1 | 54 | (gnu packages gawk) |
1ffa7090 | 55 | (gnu packages guile) |
aa289a3e | 56 | (gnu packages gettext) |
dfb74e50 | 57 | (gnu packages compression) |
929c0f69 LC |
58 | (gnu packages multiprecision) |
59 | (gnu packages make-bootstrap) | |
b6075935 | 60 | (gnu packages package-management) |
731b9962 LC |
61 | (gnu system) |
62 | (gnu system vm) | |
10d86d54 | 63 | (gnu system install) |
e702e26a | 64 | (gnu tests) |
bdd7eb27 | 65 | (srfi srfi-1) |
dce3a40b | 66 | (srfi srfi-26) |
8c0e5b1e LC |
67 | (ice-9 match)) |
68 | ||
dce3a40b LC |
69 | ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output |
70 | ;; port to the bit bucket, let us write to the error port instead. | |
71 | (setvbuf (current-error-port) _IOLBF) | |
72 | (set-current-output-port (current-error-port)) | |
73 | ||
929c0f69 LC |
74 | (define* (package->alist store package system |
75 | #:optional (package-derivation package-derivation)) | |
8c0e5b1e | 76 | "Convert PACKAGE to an alist suitable for Hydra." |
9c3bb4c5 LC |
77 | (parameterize ((%graft? #f)) |
78 | `((derivation . ,(derivation-file-name | |
79 | (package-derivation store package system | |
80 | #:graft? #f))) | |
81 | (description . ,(package-synopsis package)) | |
82 | (long-description . ,(package-description package)) | |
83 | (license . ,(package-license package)) | |
84 | (home-page . ,(package-home-page package)) | |
85 | (maintainers . ("bug-guix@gnu.org")) | |
86 | (max-silent-time . ,(or (assoc-ref (package-properties package) | |
87 | 'max-silent-time) | |
88 | 3600)) ;1 hour by default | |
89 | (timeout . ,(or (assoc-ref (package-properties package) 'timeout) | |
90 | 72000))))) ;20 hours by default | |
8c0e5b1e LC |
91 | |
92 | (define (package-job store job-name package system) | |
93 | "Return a job called JOB-NAME that builds PACKAGE on SYSTEM." | |
195e81aa LC |
94 | (let ((job-name (symbol-append job-name (string->symbol ".") |
95 | (string->symbol system)))) | |
96 | `(,job-name . ,(cut package->alist store package system)))) | |
8c0e5b1e | 97 | |
929c0f69 LC |
98 | (define (package-cross-job store job-name package target system) |
99 | "Return a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET on | |
100 | SYSTEM." | |
195e81aa LC |
101 | `(,(symbol-append (string->symbol target) (string->symbol ".") job-name |
102 | (string->symbol ".") (string->symbol system)) . | |
929c0f69 | 103 | ,(cute package->alist store package system |
9c960731 LC |
104 | (lambda* (store package system #:key graft?) |
105 | (package-cross-derivation store package target system | |
106 | #:graft? graft?))))) | |
929c0f69 | 107 | |
6bf25b7b | 108 | (define %core-packages |
707c8b2c LC |
109 | ;; Note: Don't put the '-final' package variants because (1) that's |
110 | ;; implicit, and (2) they cannot be cross-built (due to the explicit input | |
111 | ;; chain.) | |
629f4d2e | 112 | (list gcc-4.8 gcc-4.9 gcc-5 glibc binutils |
17315967 | 113 | gmp mpfr mpc coreutils findutils diffutils patch sed grep |
d116695b | 114 | gawk gnu-gettext hello guile-2.0 guile-2.2 zlib gzip xz |
9306d350 LC |
115 | %bootstrap-binaries-tarball |
116 | %binutils-bootstrap-tarball | |
530b8bda | 117 | (%glibc-bootstrap-tarball) |
9306d350 | 118 | %gcc-bootstrap-tarball |
58ab9f9b LC |
119 | %guile-bootstrap-tarball |
120 | %bootstrap-tarballs)) | |
929c0f69 | 121 | |
6bf25b7b LC |
122 | (define %packages-to-cross-build |
123 | %core-packages) | |
124 | ||
929c0f69 | 125 | (define %cross-targets |
58ab9f9b | 126 | '("mips64el-linux-gnu" |
6ef6246c | 127 | "mips64el-linux-gnuabi64" |
9410a5aa | 128 | "arm-linux-gnueabihf" |
ac16cf3e | 129 | "aarch64-linux-gnu" |
677b3022 LC |
130 | "powerpc-linux-gnu" |
131 | "i586-pc-gnu" ;aka. GNU/Hurd | |
132 | "i686-w64-mingw32")) | |
929c0f69 | 133 | |
e702e26a LC |
134 | (define %guixsd-supported-systems |
135 | '("x86_64-linux" "i686-linux")) | |
136 | ||
731b9962 LC |
137 | (define (qemu-jobs store system) |
138 | "Return a list of jobs that build QEMU images for SYSTEM." | |
139 | (define (->alist drv) | |
0ec6237b | 140 | `((derivation . ,(derivation-file-name drv)) |
731b9962 LC |
141 | (description . "Stand-alone QEMU image of the GNU system") |
142 | (long-description . "This is a demo stand-alone QEMU image of the GNU | |
143 | system.") | |
144 | (license . ,gpl3+) | |
145 | (home-page . ,%guix-home-page-url) | |
146 | (maintainers . ("bug-guix@gnu.org")))) | |
147 | ||
148 | (define (->job name drv) | |
149 | (let ((name (symbol-append name (string->symbol ".") | |
150 | (string->symbol system)))) | |
9c3bb4c5 LC |
151 | `(,name . ,(lambda () |
152 | (parameterize ((%graft? #f)) | |
153 | (->alist drv)))))) | |
731b9962 | 154 | |
10d86d54 LC |
155 | (define MiB |
156 | (expt 2 20)) | |
157 | ||
e702e26a | 158 | (if (member system %guixsd-supported-systems) |
a3a27745 | 159 | (list (->job 'usb-image |
10d86d54 | 160 | (run-with-store store |
e87f0591 LC |
161 | (mbegin %store-monad |
162 | (set-guile-for-build (default-guile)) | |
163 | (system-disk-image installation-os | |
164 | #:disk-image-size | |
622b2304 | 165 | (* 1024 MiB)))))) |
731b9962 LC |
166 | '())) |
167 | ||
e702e26a LC |
168 | (define (system-test-jobs store system) |
169 | "Return a list of jobs for the system tests." | |
ab23fb83 LC |
170 | (define (test->thunk test) |
171 | (lambda () | |
172 | (define drv | |
173 | (run-with-store store | |
174 | (mbegin %store-monad | |
175 | (set-current-system system) | |
176 | (set-grafting #f) | |
177 | (set-guile-for-build (default-guile)) | |
178 | (system-test-value test)))) | |
179 | ||
180 | `((derivation . ,(derivation-file-name drv)) | |
181 | (description . ,(format #f "GuixSD '~a' system test" | |
182 | (system-test-name test))) | |
183 | (long-description . ,(system-test-description test)) | |
184 | (license . ,gpl3+) | |
185 | (home-page . ,%guix-home-page-url) | |
186 | (maintainers . ("bug-guix@gnu.org"))))) | |
187 | ||
e702e26a LC |
188 | (define (->job test) |
189 | (let ((name (string->symbol | |
190 | (string-append "test." (system-test-name test) | |
191 | "." system)))) | |
ab23fb83 | 192 | (cons name (test->thunk test)))) |
e702e26a LC |
193 | |
194 | (if (member system %guixsd-supported-systems) | |
195 | (map ->job (all-system-tests)) | |
196 | '())) | |
197 | ||
b6075935 LC |
198 | (define (tarball-jobs store system) |
199 | "Return Hydra jobs to build the self-contained Guix binary tarball." | |
200 | (define (->alist drv) | |
201 | `((derivation . ,(derivation-file-name drv)) | |
202 | (description . "Stand-alone binary Guix tarball") | |
203 | (long-description . "This is a tarball containing binaries of Guix and | |
204 | all its dependencies, and ready to be installed on non-GuixSD distributions.") | |
205 | (license . ,gpl3+) | |
206 | (home-page . ,%guix-home-page-url) | |
207 | (maintainers . ("bug-guix@gnu.org")))) | |
208 | ||
209 | (define (->job name drv) | |
210 | (let ((name (symbol-append name (string->symbol ".") | |
211 | (string->symbol system)))) | |
9c3bb4c5 LC |
212 | `(,name . ,(lambda () |
213 | (parameterize ((%graft? #f)) | |
214 | (->alist drv)))))) | |
b6075935 LC |
215 | |
216 | ;; XXX: Add a job for the stable Guix? | |
217 | (list (->job 'binary-tarball | |
218 | (run-with-store store | |
219 | (mbegin %store-monad | |
220 | (set-guile-for-build (default-guile)) | |
239c2266 LC |
221 | (>>= (profile-derivation (packages->manifest (list guix))) |
222 | (lambda (profile) | |
223 | (self-contained-tarball "guix-binary" profile | |
32e18d37 | 224 | #:localstatedir? #t |
239c2266 LC |
225 | #:compressor |
226 | (lookup-compressor "xz"))))) | |
b6075935 LC |
227 | #:system system)))) |
228 | ||
4e097f86 LC |
229 | (define job-name |
230 | ;; Return the name of a package's job. | |
231 | (compose string->symbol package-full-name)) | |
232 | ||
233 | (define package->job | |
234 | (let ((base-packages | |
235 | (delete-duplicates | |
236 | (append-map (match-lambda | |
237 | ((_ package _ ...) | |
238 | (match (package-transitive-inputs package) | |
239 | (((_ inputs _ ...) ...) | |
240 | inputs)))) | |
0a050ebc | 241 | (%final-inputs))))) |
4e097f86 LC |
242 | (lambda (store package system) |
243 | "Return a job for PACKAGE on SYSTEM, or #f if this combination is not | |
244 | valid." | |
245 | (cond ((member package base-packages) | |
246 | #f) | |
bbceb0ef | 247 | ((supported-package? package system) |
4e097f86 LC |
248 | (package-job store (job-name package) package system)) |
249 | (else | |
250 | #f))))) | |
251 | ||
252 | \f | |
253 | ;;; | |
254 | ;;; Hydra entry point. | |
255 | ;;; | |
256 | ||
8c0e5b1e LC |
257 | (define (hydra-jobs store arguments) |
258 | "Return Hydra jobs." | |
6bf25b7b LC |
259 | (define subset |
260 | (match (assoc-ref arguments 'subset) | |
261 | ("core" 'core) ; only build core packages | |
262 | (_ 'all))) ; build everything | |
263 | ||
77bed842 | 264 | (define (cross-jobs system) |
e7958902 | 265 | (define (from-32-to-64? target) |
eb55e28c MW |
266 | ;; Return true if SYSTEM is 32-bit and TARGET is 64-bit. This hack |
267 | ;; prevents known-to-fail cross-builds from i686-linux or armhf-linux to | |
e7958902 | 268 | ;; mips64el-linux-gnuabi64. |
eb55e28c | 269 | (and (or (string-prefix? "i686-" system) |
9ec2a4d3 | 270 | (string-prefix? "i586-" system) |
eb55e28c | 271 | (string-prefix? "armhf-" system)) |
9ec2a4d3 | 272 | (string-contains target "64"))) ;x86_64, mips64el, aarch64, etc. |
e7958902 | 273 | |
411fc81d LC |
274 | (define (same? target) |
275 | ;; Return true if SYSTEM and TARGET are the same thing. This is so we | |
276 | ;; don't try to cross-compile to 'mips64el-linux-gnu' from | |
277 | ;; 'mips64el-linux'. | |
9ec2a4d3 LC |
278 | (or (string-contains target system) |
279 | (and (string-prefix? "armhf" system) ;armhf-linux | |
280 | (string-prefix? "arm" target)))) ;arm-linux-gnueabihf | |
411fc81d | 281 | |
dea91108 LC |
282 | (define (pointless? target) |
283 | ;; Return #t if it makes no sense to cross-build to TARGET from SYSTEM. | |
284 | (and (string-contains target "mingw") | |
285 | (not (string=? "x86_64-linux" system)))) | |
286 | ||
a69bc707 | 287 | (define (either proc1 proc2 proc3) |
411fc81d | 288 | (lambda (x) |
a69bc707 | 289 | (or (proc1 x) (proc2 x) (proc3 x)))) |
411fc81d | 290 | |
929c0f69 LC |
291 | (append-map (lambda (target) |
292 | (map (lambda (package) | |
293 | (package-cross-job store (job-name package) | |
294 | package target system)) | |
295 | %packages-to-cross-build)) | |
dea91108 LC |
296 | (remove (either from-32-to-64? same? pointless?) |
297 | %cross-targets))) | |
929c0f69 | 298 | |
49c4fd2a LC |
299 | ;; Turn off grafts. Grafting is meant to happen on the user's machines. |
300 | (parameterize ((%graft? #f)) | |
301 | ;; Return one job for each package, except bootstrap packages. | |
302 | (append-map (lambda (system) | |
303 | (case subset | |
304 | ((all) | |
305 | ;; Build everything, including replacements. | |
306 | (let ((all (fold-packages | |
307 | (lambda (package result) | |
6f9f01fb LC |
308 | (cond ((package-replacement package) |
309 | (cons* package | |
310 | (package-replacement package) | |
311 | result)) | |
312 | ((package-superseded package) | |
313 | result) ;don't build it | |
314 | (else | |
315 | (cons package result)))) | |
49c4fd2a LC |
316 | '())) |
317 | (job (lambda (package) | |
318 | (package->job store package | |
319 | system)))) | |
320 | (append (filter-map job all) | |
321 | (qemu-jobs store system) | |
e702e26a | 322 | (system-test-jobs store system) |
49c4fd2a LC |
323 | (tarball-jobs store system) |
324 | (cross-jobs system)))) | |
325 | ((core) | |
326 | ;; Build core packages only. | |
327 | (append (map (lambda (package) | |
328 | (package-job store (job-name package) | |
329 | package system)) | |
330 | %core-packages) | |
331 | (cross-jobs system))) | |
332 | (else | |
333 | (error "unknown subset" subset)))) | |
334 | %hydra-supported-systems))) |