1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
#!/bin/sh
# -*- scheme -*-
# @configure_input@
GUILE_LOAD_PATH="$1${GUILE_LOAD_PATH:+:}$GUILE_LOAD_PATH"
export GUILE_LOAD_PATH
exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
!#
;;;; evaluate -- convert a specification to a job list
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of Cuirass.
;;;
;;; Cuirass is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Cuirass is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
(use-modules (cuirass)
(ice-9 match)
(ice-9 pretty-print)
(srfi srfi-26)
(guix build utils)
(guix derivations)
(guix store))
(define (fill-job job eval-id)
"Augment the JOB alist with EVAL-ID and additional information
gathered from JOB’s #:derivation."
(let ((drv (read-derivation-from-file
(assq-ref job #:derivation))))
`((#:eval-id . ,eval-id)
(#:nix-name . ,(derivation-name drv))
(#:system . ,(derivation-system drv))
,@job)))
(define* (main #:optional (args (command-line)))
(match args
((command load-path guix-package-path cachedir specstr database)
;; Load FILE, a Scheme file that defines Hydra jobs.
(let ((%user-module (make-fresh-user-module))
(spec (with-input-from-string specstr read))
(stdout (current-output-port))
(stderr (current-error-port)))
(save-module-excursion
(lambda ()
(set-current-module %user-module)
(with-directory-excursion
(string-append cachedir "/" (assq-ref spec #:name))
(primitive-load (assq-ref spec #:file)))))
(with-store store
(unless (assoc-ref spec #:use-substitutes?)
;; Make sure we don't resort to substitutes.
(set-build-options store #:use-substitutes? #f #:substitute-urls '()))
;; Grafts can trigger early builds. We do not want that to happen
;; during evaluation, so use a sledgehammer to catch such problems.
(set! build-things
(lambda (store . args)
(display "error: trying to build things during evaluation!~%"
stderr)
(simple-format stderr "'build-things' arguments: ~S~%" args)
(exit 1)))
(parameterize ((%package-database database)
(%use-substitutes? (assoc-ref spec #:use-substitutes?)))
(unless (string-null? guix-package-path)
(set-guix-package-path! guix-package-path))
;; Call the entry point of FILE and print the resulting job sexp.
(let* ((proc-name (assq-ref spec #:proc))
(proc (module-ref %user-module proc-name))
(thunks (proc store (assq-ref spec #:arguments)))
(db (db-open))
(commit (assq-ref spec #:current-commit))
(eval `((#:specification . ,(assq-ref spec #:name))
(#:revision . ,commit)))
(eval-id (db-add-evaluation db eval)))
(pretty-print
(map (lambda (thunk)
(let* ((job (call-with-time-display thunk))
;; Fill job with informations that will later be
;; added to database.
(job* (fill-job job eval-id)))
(db-add-derivation db job*)
job*))
thunks)
stdout)
(db-close db))))))
((command _ ...)
(simple-format (current-error-port) "Usage: ~A FILE
Evaluate the Hydra jobs defined in FILE.~%"
command)
(exit 1))))
|