Commit | Line | Data |
---|---|---|
233e7676 | 1 | ;;; GNU Guix --- Functional package management for GNU |
e87f0591 | 2 | ;;; Copyright © 2012, 2013, 2014, 2015 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) | |
8c0e5b1e | 41 | (guix packages) |
97d010b7 | 42 | (guix derivations) |
731b9962 LC |
43 | (guix monads) |
44 | ((guix licenses) #:select (gpl3+)) | |
dce3a40b | 45 | ((guix utils) #:select (%current-system)) |
731b9962 | 46 | ((guix scripts system) #:select (read-operating-system)) |
59a43334 | 47 | (gnu packages) |
d452b595 | 48 | (gnu packages gcc) |
1ffa7090 | 49 | (gnu packages base) |
923fbae1 | 50 | (gnu packages gawk) |
1ffa7090 | 51 | (gnu packages guile) |
aa289a3e | 52 | (gnu packages gettext) |
dfb74e50 | 53 | (gnu packages compression) |
929c0f69 LC |
54 | (gnu packages multiprecision) |
55 | (gnu packages make-bootstrap) | |
9e9cb0c7 | 56 | (gnu packages commencement) |
b6075935 | 57 | (gnu packages package-management) |
731b9962 LC |
58 | (gnu system) |
59 | (gnu system vm) | |
10d86d54 | 60 | (gnu system install) |
bdd7eb27 | 61 | (srfi srfi-1) |
dce3a40b | 62 | (srfi srfi-26) |
8c0e5b1e LC |
63 | (ice-9 match)) |
64 | ||
dce3a40b LC |
65 | ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output |
66 | ;; port to the bit bucket, let us write to the error port instead. | |
67 | (setvbuf (current-error-port) _IOLBF) | |
68 | (set-current-output-port (current-error-port)) | |
69 | ||
929c0f69 LC |
70 | (define* (package->alist store package system |
71 | #:optional (package-derivation package-derivation)) | |
8c0e5b1e | 72 | "Convert PACKAGE to an alist suitable for Hydra." |
3301f179 | 73 | `((derivation . ,(derivation-file-name |
9c960731 LC |
74 | (package-derivation store package system |
75 | #:graft? #f))) | |
8c0e5b1e LC |
76 | (description . ,(package-synopsis package)) |
77 | (long-description . ,(package-description package)) | |
78 | (license . ,(package-license package)) | |
bdd7eb27 | 79 | (home-page . ,(package-home-page package)) |
65f7c35d | 80 | (maintainers . ("bug-guix@gnu.org")) |
ae0bcc1e MW |
81 | (timeout . ,(or (assoc-ref (package-properties package) 'timeout) |
82 | 72000)))) ; 20 hours by default | |
8c0e5b1e LC |
83 | |
84 | (define (package-job store job-name package system) | |
85 | "Return a job called JOB-NAME that builds PACKAGE on SYSTEM." | |
195e81aa LC |
86 | (let ((job-name (symbol-append job-name (string->symbol ".") |
87 | (string->symbol system)))) | |
88 | `(,job-name . ,(cut package->alist store package system)))) | |
8c0e5b1e | 89 | |
929c0f69 LC |
90 | (define (package-cross-job store job-name package target system) |
91 | "Return a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET on | |
92 | SYSTEM." | |
195e81aa LC |
93 | `(,(symbol-append (string->symbol target) (string->symbol ".") job-name |
94 | (string->symbol ".") (string->symbol system)) . | |
929c0f69 | 95 | ,(cute package->alist store package system |
9c960731 LC |
96 | (lambda* (store package system #:key graft?) |
97 | (package-cross-derivation store package target system | |
98 | #:graft? graft?))))) | |
929c0f69 | 99 | |
6bf25b7b | 100 | (define %core-packages |
707c8b2c LC |
101 | ;; Note: Don't put the '-final' package variants because (1) that's |
102 | ;; implicit, and (2) they cannot be cross-built (due to the explicit input | |
103 | ;; chain.) | |
d452b595 | 104 | (list gcc-4.8 gcc-4.7 glibc binutils |
17315967 | 105 | gmp mpfr mpc coreutils findutils diffutils patch sed grep |
dfb74e50 | 106 | gawk gnu-gettext hello guile-2.0 zlib gzip xz |
9306d350 LC |
107 | %bootstrap-binaries-tarball |
108 | %binutils-bootstrap-tarball | |
109 | %glibc-bootstrap-tarball | |
110 | %gcc-bootstrap-tarball | |
58ab9f9b LC |
111 | %guile-bootstrap-tarball |
112 | %bootstrap-tarballs)) | |
929c0f69 | 113 | |
6bf25b7b LC |
114 | (define %packages-to-cross-build |
115 | %core-packages) | |
116 | ||
929c0f69 | 117 | (define %cross-targets |
58ab9f9b LC |
118 | '("mips64el-linux-gnu" |
119 | "mips64el-linux-gnuabi64")) | |
929c0f69 | 120 | |
10d86d54 LC |
121 | (define (demo-os) |
122 | "Return the \"demo\" 'operating-system' structure." | |
123 | (let* ((dir (dirname (assoc-ref (current-source-location) 'filename))) | |
124 | (file (string-append dir "/demo-os.scm"))) | |
125 | (read-operating-system file))) | |
126 | ||
731b9962 LC |
127 | (define (qemu-jobs store system) |
128 | "Return a list of jobs that build QEMU images for SYSTEM." | |
129 | (define (->alist drv) | |
0ec6237b | 130 | `((derivation . ,(derivation-file-name drv)) |
731b9962 LC |
131 | (description . "Stand-alone QEMU image of the GNU system") |
132 | (long-description . "This is a demo stand-alone QEMU image of the GNU | |
133 | system.") | |
134 | (license . ,gpl3+) | |
135 | (home-page . ,%guix-home-page-url) | |
136 | (maintainers . ("bug-guix@gnu.org")))) | |
137 | ||
138 | (define (->job name drv) | |
139 | (let ((name (symbol-append name (string->symbol ".") | |
140 | (string->symbol system)))) | |
1b282ea8 | 141 | `(,name . ,(cut ->alist drv)))) |
731b9962 | 142 | |
10d86d54 LC |
143 | (define MiB |
144 | (expt 2 20)) | |
145 | ||
146 | (if (member system '("x86_64-linux" "i686-linux")) | |
147 | (list (->job 'qemu-image | |
148 | (run-with-store store | |
e87f0591 LC |
149 | (mbegin %store-monad |
150 | (set-guile-for-build (default-guile)) | |
151 | (system-qemu-image (demo-os) | |
152 | #:disk-image-size | |
153 | (* 1400 MiB))))) ; 1.4 GiB | |
10d86d54 LC |
154 | (->job 'usb-image |
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 | |
897e5d99 | 160 | (* 860 MiB)))))) |
731b9962 LC |
161 | '())) |
162 | ||
b6075935 LC |
163 | (define (tarball-jobs store system) |
164 | "Return Hydra jobs to build the self-contained Guix binary tarball." | |
165 | (define (->alist drv) | |
166 | `((derivation . ,(derivation-file-name drv)) | |
167 | (description . "Stand-alone binary Guix tarball") | |
168 | (long-description . "This is a tarball containing binaries of Guix and | |
169 | all its dependencies, and ready to be installed on non-GuixSD distributions.") | |
170 | (license . ,gpl3+) | |
171 | (home-page . ,%guix-home-page-url) | |
172 | (maintainers . ("bug-guix@gnu.org")))) | |
173 | ||
174 | (define (->job name drv) | |
175 | (let ((name (symbol-append name (string->symbol ".") | |
176 | (string->symbol system)))) | |
177 | `(,name . ,(cut ->alist drv)))) | |
178 | ||
179 | ;; XXX: Add a job for the stable Guix? | |
180 | (list (->job 'binary-tarball | |
181 | (run-with-store store | |
182 | (mbegin %store-monad | |
183 | (set-guile-for-build (default-guile)) | |
184 | (self-contained-tarball)) | |
185 | #:system system)))) | |
186 | ||
4e097f86 LC |
187 | (define job-name |
188 | ;; Return the name of a package's job. | |
189 | (compose string->symbol package-full-name)) | |
190 | ||
191 | (define package->job | |
192 | (let ((base-packages | |
193 | (delete-duplicates | |
194 | (append-map (match-lambda | |
195 | ((_ package _ ...) | |
196 | (match (package-transitive-inputs package) | |
197 | (((_ inputs _ ...) ...) | |
198 | inputs)))) | |
199 | %final-inputs)))) | |
200 | (lambda (store package system) | |
201 | "Return a job for PACKAGE on SYSTEM, or #f if this combination is not | |
202 | valid." | |
203 | (cond ((member package base-packages) | |
204 | #f) | |
bbceb0ef | 205 | ((supported-package? package system) |
4e097f86 LC |
206 | (package-job store (job-name package) package system)) |
207 | (else | |
208 | #f))))) | |
209 | ||
210 | \f | |
211 | ;;; | |
212 | ;;; Hydra entry point. | |
213 | ;;; | |
214 | ||
8c0e5b1e LC |
215 | (define (hydra-jobs store arguments) |
216 | "Return Hydra jobs." | |
6bf25b7b LC |
217 | (define subset |
218 | (match (assoc-ref arguments 'subset) | |
219 | ("core" 'core) ; only build core packages | |
220 | (_ 'all))) ; build everything | |
221 | ||
77bed842 | 222 | (define (cross-jobs system) |
e7958902 LC |
223 | (define (from-32-to-64? target) |
224 | ;; Return true if SYSTEM is 32-bit and TARGET is 64-bit. | |
225 | ;; This hacks prevents known-to-fail cross-builds from i686-linux to | |
226 | ;; mips64el-linux-gnuabi64. | |
227 | (and (string-prefix? "i686-" system) | |
228 | (string-suffix? "64" target))) | |
229 | ||
411fc81d LC |
230 | (define (same? target) |
231 | ;; Return true if SYSTEM and TARGET are the same thing. This is so we | |
232 | ;; don't try to cross-compile to 'mips64el-linux-gnu' from | |
233 | ;; 'mips64el-linux'. | |
234 | (string-contains target system)) | |
235 | ||
236 | (define (either proc1 proc2) | |
237 | (lambda (x) | |
238 | (or (proc1 x) (proc2 x)))) | |
239 | ||
929c0f69 LC |
240 | (append-map (lambda (target) |
241 | (map (lambda (package) | |
242 | (package-cross-job store (job-name package) | |
243 | package target system)) | |
244 | %packages-to-cross-build)) | |
411fc81d | 245 | (remove (either from-32-to-64? same?) %cross-targets))) |
929c0f69 | 246 | |
bdd7eb27 | 247 | ;; Return one job for each package, except bootstrap packages. |
4e097f86 LC |
248 | (append-map (lambda (system) |
249 | (case subset | |
250 | ((all) | |
251 | ;; Build everything. | |
252 | (fold-packages (lambda (package result) | |
253 | (let ((job (package->job store package | |
254 | system))) | |
255 | (if job | |
256 | (cons job result) | |
257 | result))) | |
258 | (append (qemu-jobs store system) | |
b6075935 | 259 | (tarball-jobs store system) |
4e097f86 LC |
260 | (cross-jobs system)))) |
261 | ((core) | |
262 | ;; Build core packages only. | |
263 | (append (map (lambda (package) | |
264 | (package-job store (job-name package) | |
265 | package system)) | |
266 | %core-packages) | |
267 | (cross-jobs system))) | |
268 | (else | |
269 | (error "unknown subset" subset)))) | |
95203be9 | 270 | %hydra-supported-systems)) |